This is my response to the Perl Weekly Challenge #134.
Pandigital Numbers in base 10.
Let us start with Brute Force, generating numbers en masse and checking them:
File: pandigital-number-loop
#! /usr/bin/env raku
unit sub MAIN (Int $n where $n > 0 = 5, :v($verbose));
my $pandigital-seq := gather
{
my $base = 10; # [2]
my @base = 0 .. 9; # [2]
my $start = (1 ~ '0' x $base -1).Int; # [1]
say ":Start: $start" if $verbose;
for $start .. Inf -> $candidate
{
say ":Checking $candidate" if $verbose;
take $candidate if $candidate.comb.unique.elems == $base; # [3]
}
}
say $pandigital-seq[^$n].join(", ");
[1] We know that the numbers must have at least 10 digits, as all of them (the digits) has to be present. We also know that the first digit cannot be zero, as that would give a nine digit number. So we start with the lowest possible 10 digit number; 1_000_000_000.
[2] These lines are the start of an abandoned idea of supporting different bases, as I did last week.
[3] Get the individual digits (comb), get rid
of duplicates (unqiue), and count them (elems). If the
count is the same as the base (in this case 10), we know that all the digits are
represented - and we have a Pandigital Number.
See
docs.raku.org/routine/unique
for more information about unique.
Running it:
$ ./pandigital-number-loop
1023456789, 1023456798, 1023456879, 1023456897, 1023456978
This is extremely inefficient - and slow, as we are generating and checking a lot of numbers that does not contain all the digits. The program took almost 5 minutes on my PC.
We can use permutations to sidestep this issue:
#! /usr/bin/env raku
unit sub MAIN (Int $n where $n > 0 = 5, :v($verbose));
my $pandigital-seq := gather
{
my @base = 0 .. 9;
for @base.permutations -> @permutation # [1]
{
say ":Candidate ", @permutation.join("") if $verbose;
take @permutation.join unless @permutation[0] == 0; # [2]
}
}
say $pandigital-seq[^$n].join(", ");
[1] This will give us all the permutations (or sorting order) of the 10 digits.
See
docs.raku.org/routine/permutations for more information about permutations.
[2] Use the value if the first digit is not 0.
Running it:
$ ./pandigital-number-permutations
1023456789, 1023456798, 1023456879, 1023456897, 1023456978
This program is extremely fast, compared with the first one. It took 0.7 seconds on my PC.
We have a (time) problem with leading zeroes. We can use verbose mode to see how much of a problem:
$ ./pandigital-number-permutations -v
:Candidate 0123456789
:Candidate 0123456798
362881 lines not shown
:Candidate 1023456897
:Candidate 1023456978
1023456789, 1023456798, 1023456879, 1023456897, 1023456978
We can do better, by eliminating the leading zero:
File: pandigital-number
#! /usr/bin/env raku
unit sub MAIN (Int $n where $n > 0 = 5);
my $pandigital-seq := gather
{
my @base = 0 .. 9;
for 1 .. 9 -> $first
{
my @rest = (@base (-) $first).keys.sort;
for @rest.permutations -> @permutation
{
take ($first ~ @permutation.join);
}
}
}
say $pandigital-seq[^$n].join(", ");
Running it:
$ ./pandigital-number
1023456789, 1023456798, 1023456879, 1023456897, 1023456978
This program took 0.15 seconds on my PC. Quite a speedup.
The challenge asked for the first 5 numbers, but all my programs can be asked to supply as many as you want. The second and third program uses permuntations, and will only give 10 digit numbers. Let us see how quick we run out of those:
$ ./pandigital-number 3265920
1023456789, … 9876543210
Spot on! This was the result of trial and error. And patience. The command above took 1 minute and 37 seconds.
In case you wonder, the programs will happily go on off the cliff, and generate warnings as they run out of values.
In case you wonder if it is easy to add support for 11 digit numbers and so on in
the versions using permutations, the answer is no.
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Algorithm::Combinatorics 'permutations'; # [1]
use Array::Utils 'array_minus';
my $n = $ARGV[0] // 5;
die "Postive integer only" unless $n =~ /^[1-9]\d*$/;
my @result;
my @base = (0 .. 9);
LOOP:
for my $first (1 .. 9)
{
my @first = ($first); # [2]
my @rest = array_minus(@base, @first); # [2]
for my $permutation (permutations(\@rest))
{
push(@result, ($first . join("", @$permutation)));
last LOOP if @result == $n;
}
}
say join(", ", @result);
[1] The modules are probably not installed by default. Use CPAN, or install the «libalgorithm-combinatorics-perl» and «libarray-utils-perl» if on a Debian/Ubuntu system.
[2] Both arguments to «array_minus» must be arrays, so we have to wrap the second one (a single element) like this.
Running it gives the same result as the Raku version:
$ ./pandigital-number-perl
1023456789, 1023456798, 1023456879, 1023456897, 1023456978
$m and $n.
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
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
File: distinct-terms-count-twice
#! /usr/bin/env raku
unit sub MAIN (Int $m where $m > 0, Int $n where $n > 0, :v($verbose));
my $width = ($m * $n).chars; # [1]
my $r-width = ($m).chars; # [2]
say ":Max width number: $width" if $verbose; # [1a]
say ":Max width row ID: $r-width" if $verbose; # [2a]
say "x".fmt("%{$width-1}s"), " |", # [3]
(1..$n).map({ $_.fmt("%{$width}d") }).join(" "); # [4]
say "-" x $r-width, "-+", "-" x ($n * ($width +1) -1);
for 1 .. $m -> $row # [5]
{
say "{ $row.fmt("%{$r-width}d") } |", # [3]
(1..$n).map({ ($row * $_).fmt("%{$width}d") }).join(" ");
}
my @values; # [6]
for 1 .. $m -> $row
{
for 1 .. $n -> $col
{
@values.push: $row * $col; # [6]
}
}
my @distinct = @values.sort.squish; # [7]
say "";
say "Distinct Terms: { @distinct.join(", ") }";
say "Count: { @distinct.elems }";
[1] The width of the largest number in the matrix, as we want nicely tabulated data.
[2] The width of the lagest row number.
[3] Note the use of fmt, the method version of
sprintf, to ge tthe tabulation right.
[4] The top rowm with the column numbers.
[5] Print each row.
[6] Get (compute each value) and add them to list.
[7] Get the unique values (with squish, which requires
a sorted list to work out, on the sorted list), and print them. (If the data is unsorted,
use unique instead.)
See
docs.raku.org/routine/fmt
more information about fmt.
See
docs.raku.org/routine/squish
for more information about squish.
Running it:
$ ./distinct-terms-count-twice 3 3
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
$ ./distinct-terms-count-twice 3 5
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
Looking good.
Note that we computed the values twice; first when printing them, and a second time when sorting out the distinct terms. That is not efficient, but easy(ish) to fix:
File: distinct-terms-count
#! /usr/bin/env raku
unit sub MAIN (Int $m where $m > 0, Int $n where $n > 0, :v($verbose));
my @values; # [1a]
for 1 .. $m -> $row
{
@values.push: (1 .. $n).map({ $_ * $row }); # [1]
}
# say ":", @values.raku;
my $width = ($m * $n).chars;
my $r-width = ($m).chars;
say ":Max width number: $width" if $verbose;
say ":Max width row ID: $r-width" if $verbose;
say "x".fmt("%{$width-1}s"),
" |",
(1..$n).map({ $_.fmt("%{$width}d") }).join(" ");
say "-" x $r-width, "-+", "-" x ($n * ($width +1) -1);
for @values -> @row
{
state $i = 0; # [2]
say "{ (++$i).fmt("%{$r-width}d") } |",
@row.map({ ($_).fmt("%{$width}d") }).join(" ");
}
my @distinct = @values>>.List.flat.sort.squish; # [3]
say "";
say "Distinct Terms: { @distinct.join(", ") }";
say "Count: { @distinct.elems }";
[1] Start with computing the rows, and add them to an array [1a]. Each row is an element in this array.
[2] Print the rows. Note the state variable used to print the row numbers.
[3] We have a two dimentional array, so have to flatten it before sorting the values.
Running it gives the same result as before:
$ ./distinct-terms-count-twice 3 3
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
$ ./distinct-terms-count 3 5
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
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use Getopt::Long;
use List::Util 'uniq' ; # [1]
my $verbose = 0;
GetOptions("verbose" => \$verbose);
my $m = $ARGV[0] // 0;
my $n = $ARGV[1] // 0;
die "Postive integer only" unless $m =~ /^[1-9]\d*$/;
die "Postive integer only" unless $n =~ /^[1-9]\d*$/;
my @values;
for my $row (1 .. $m)
{
my @row = map { $_ * $row } 1.. $n;
push(@values, \@row);
}
my $width = length($m * $n);
my $r_width = length($m);
say ":Max width number: $width" if $verbose;
say ":Max width row ID: $r_width" if $verbose;
say sprintf('%' . ( $width - 1 ) . "s", "x"),
" |",
join(" ", map { sprintf('%' . $width . "d", $_) } (1..$n));
say "-" x $r_width, "-+", "-" x ($n * ($width +1) );
my $i = 0; # [2]
my @all;
for my $row (@values)
{
my @row = @$row;
push(@all, @row);
say sprintf('%' . $r_width . "d", ++$i) ,
" |",
join(" ", map { sprintf('%' . $width . "d", $_) } @row);
}
my @distinct = sort { $a <=> $b } uniq(@all);
say "";
say "Distinct Terms: ", join(", ", @distinct);
say "Count: " . @distinct;
[1] Available in the package «libscalar-list-utils-perl» on Debian/Ubuntu.
[2] A regular variable, set up ouside the loop, works as well as the state variable used in Raku. Except that the variable is available ouside of the loop.
Running it gives the same result as the Raku versions:
$ ./distinct-terms-count-perl 3 3
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
$ ./distinct-terms-count-perl 3 5
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
$ ./distinct-terms-count-perl 10 10
x | 1 2 3 4 5 6 7 8 9 10
---+----------------------------------------
1 | 1 2 3 4 5 6 7 8 9 10
2 | 2 4 6 8 10 12 14 16 18 20
3 | 3 6 9 12 15 18 21 24 27 30
4 | 4 8 12 16 20 24 28 32 36 40
5 | 5 10 15 20 25 30 35 40 45 50
6 | 6 12 18 24 30 36 42 48 54 60
7 | 7 14 21 28 35 42 49 56 63 70
8 | 8 16 24 32 40 48 56 64 72 80
9 | 9 18 27 36 45 54 63 72 81 90
10 | 10 20 30 40 50 60 70 80 90 100
Distinct Terms: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 14, 15, 16, 18, 20, 21, \
24, 25, 27, 28, 30, 32, 35, 36, 40, 42, 45, 48, 49, 50, 54, 56, 60, 63, \
64, 70, 72, 80, 81, 90, 100
Count: 42
And that's it.