Perl Weekly Challenge 134.
My solutions (task 1, and task 2 ) to the The Weekly Challenge - 134.
Task 1: Pandigital Numbers
Submitted by: Mohammad S Anwar
Write a script to generate first 5 Pandigital Numbers in
base 10.
As per the wikipedia, it says:
A pandigital number is an integer that in a given base has
among its significant digits each digit used in the base at
least once.
A pandigital number in base b must have at least b digits. The smallest such number is produced if I order the digits left to right from smallest to highest, that is, we want the most significant digits to be as small as possible and we don’t care that much about the least significant digits. To obtain other pandigital we just permute the rightmost digits so that large digits don’t move much towards the right.
Thus, it would seem that the first pandigital numbers in base ten would be
- 0123456789
- 0123456798
- 0123456879
- 0123456897
- 0123456879
This may be considered incorrect, as 0 is not considered a standard digit to start a number. Thus we can interchange 1 and 0 to obtain
- 1023456789
- 1023456798
- 1023456879
- 1023456897
- 1023456978
Therfore, a short solution using the cpan module
List::Permutor is
perl -MList::Permutor -E '$p=List::Permutor->new(1,0,2..9); say $p->next for 1..5;'
Results:
1023456789
1023456798
1023456879
1023456897
1023456978
as List::Permutor permutes rightmost first. A full solution if more than (b-1)! numbers are required would have to consider that 0 may not be permutted to the leftmost position, and then, additional digits, starting with 1, should be added to the left. I avoid those complications and just confess that my full solution below has limitations.
# Perl weekly challenge 134
# Task 1: Pandigital numbers
#
# See https://wlmb.github.io/2021/10/11/PWC134/#task-1-pandigital-numbers
use v5.12;
use warnings;
use List::Util qw(product);
use List::Permutor;
say "Usage: ./ch-1.pl howmany [base]" and exit unless @ARGV>0;
my ($howmany, $base)=@ARGV;
$base//=10; #default
# The following only works if $howmany is smaller than ($base-1)!
# and $base>2
say "First $howmany pandigital numbers in base $base";
say "I'm unable to cope with a base <= 2" and exit unless $base>=3;
my $factorial=product(1..$base-1);
say "I'm unable to cope with more than ", $base-1,"!=$factorial numbers in base $base"
and exit unless $howmany<=$factorial;
my $p=List::Permutor->new(1,0,2..$base-1);
say join $base>10?"-":"", $p->next for 1..$howmany;
I could have used my permutator from PWC109, 121 or 134, but L::P seems quite convenient.
Example:
./ch-1.pl 5
Results:
First 5 pandigital numbers in base 10
1023456789
1023456798
1023456879
1023456897
1023456978
Examples with other bases:
./ch-1.pl 5 9
./ch-1.pl 5 15
Results:
First 5 pandigital numbers in base 9
102345678
102345687
102345768
102345786
102345867
First 5 pandigital numbers in base 15
1-0-2-3-4-5-6-7-8-9-10-11-12-13-14
1-0-2-3-4-5-6-7-8-9-10-11-12-14-13
1-0-2-3-4-5-6-7-8-9-10-11-13-12-14
1-0-2-3-4-5-6-7-8-9-10-11-13-14-12
1-0-2-3-4-5-6-7-8-9-10-11-14-12-13
In the last example I represents the digits as decimal numbers, so I separate them with hyphens to avoid confusion.
Border cases:
./ch-1.pl 3 2
./ch-1.pl 3 3
./ch-1.pl 2 3
./ch-1.pl 1000000 10
Results:
First 3 pandigital numbers in base 2
I'm unable to cope with a base <= 2
First 3 pandigital numbers in base 3
I'm unable to cope with more than 2!=2 numbers in base 3
First 2 pandigital numbers in base 3
102
120
First 1000000 pandigital numbers in base 10
I'm unable to cope with more than 9!=362880 numbers in base 10
Task 2: Distinct Terms Count
Submitted by: Mohammad S Anwar
You are given 2 positive numbers, $m and $n.
Write a script to generate multiplcation table and display
count of distinct terms.
Example 1
Input: $m = 3, $n = 3
Output:
x | 1 2 3
--+------
1 | 1 2 3
2 | 2 4 6
3 | 3 6 9
Distinct Terms: 1, 2, 3, 4, 6, 9
Count: 6
Example 2
Input: $m = 3, $n = 5
Output:
x | 1 2 3 4 5
--+--------------
1 | 1 2 3 4 5
2 | 2 4 6 8 10
3 | 3 6 9 12 15
Distinct Terms: 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15
Count: 11
Being lazy about the format, I can use the Perl Data
Language, which knows about printing a matrix, how to operate on
its coordinates and how to
extract and count unique
terms.1
Thus, everything fits together in a one+liner.
perl -MPDL -E '($m,$n)=@ARGV; $t=(zeroes($n,$m)->ndcoords+1)->prodover;
$u=$t->uniq; $c=$u->nelem;
say "Input: $m, $n\nOutput: ${t}Distinct terms: $u\nCount: $c"' 3 3
perl -MPDL -E '($m,$n)=@ARGV; $t=(zeroes($n,$m)->ndcoords+1)->prodover;
$u=$t->uniq; $c=$u->nelem;
say "Input: $m, $n\nOutput: ${t}Distinct terms: $u\nCount: $c"' 3 5
Results:
Input: 3, 3
Output:
[
[1 2 3]
[2 4 6]
[3 6 9]
]
Distinct terms: [1 2 3 4 6 9]
Count: 6
Input: 3, 5
Output:
[
[ 1 2 3 4 5]
[ 2 4 6 8 10]
[ 3 6 9 12 15]
]
Distinct terms: [1 2 3 4 5 6 8 9 10 12 15]
Count: 11
Notice that the top row and leftmost column of a usual multiplication table, stating which number is to be multiplied by which other, is redundant, as it is duplicated by the row and column corresponding to multiplication by 1. For simplicity I omit them. A full program is thus:
# Perl weekly challenge 134
# Task 2: Distinct Terms Count
#
# See https://wlmb.github.io/2021/10/11/PWC134/#task-2-distinct-terms-count
use v5.12;
use warnings;
use PDL;
use List::Util qw(uniqint);
say "Usage: ./ch-2.pl N M" and exit unless @ARGV==2;
my ($m, $n)=@ARGV;
my $table=(zeroes($n,$m)->ndcoords+1)->prodover;
my $uniq=$table->uniq;
my $count=$uniq->nelem;
say "Input: m=$m, n=$n";
say "Output: $table"; # Could have done a better format
say "Distinct terms: $uniq\nCount: $count;"
Examples:
./ch-2.pl 3 3
./ch-2.pl 3 5
Results:
Input: m=3, n=3
Output:
[
[1 2 3]
[2 4 6]
[3 6 9]
]
Distinct terms: [1 2 3 4 6 9]
Count: 6;
Input: m=3, n=5
Output:
[
[ 1 2 3 4 5]
[ 2 4 6 8 10]
[ 3 6 9 12 15]
]
Distinct terms: [1 2 3 4 5 6 8 9 10 12 15]
Count: 11;
Footnotes
1 By the way, it has been shown that
the speed of Perl with PDL is comparable to that of C for number
crunching