Perl Weekly Challenge: Week 134
Challenge 1:
Pandigital Numbers
Write a script to generate first 5
PandigitalNumbers 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.
Given the difficulties I have with Maths in general, I am pretty proud of my solution to this problem. Before even writing any code, I thought about it. The smallest base-10 number that contains all digits must obviously start with the smallest digit i.e. 0. But a number conventionally does not start with 0 so we have to go with the next digit 1, and 0 becomes the second digit. Therefore we know that all the first few pandigital numbers will start with 10. That leaves 8 digits. There are 8! unique permutations of those digits but we only want the first 10 pandigital numbers and the smallest factorial greater than 10 is 4! = 24. Therefore only the last 4 digits, 6, 7, 8, 9 need to be permuted. We can assume 2, 3, 4, 5 will always be in a fixed place.
Put this altogether and we can assume all the first pandigital numbers will start with 102345.
my $prefix = '102345';
Now for the remaining digits, we find all the permutations:
(<6 7 8 9>
.permutations
...these are arrays so we join them up into strings again:
.map({ $_.join })
...then the prefix is prepended to each permutation:
.map({ $prefix ~ $_ })
...the list of permutations is sorted in ascending numeric order (actually this did not seem to be needed but better to be safe.) and the first 10 values are taken:
.sort({$^a <=> $^b}))[^10]
...These are joined together separated by spaces and printed:
.join(q{ })
.say;
This is the Perl version. Perl doesn't have .permutations() so I use the tried and true routine I grabbed from perlfaq4 and used for many previous challenges.
my $prefix = '102345';
my @permutations;
permute { push @permutations, \@_; } qw/ 6 7 8 9 /;
say join q{ }, sort { $a <=> $b }
(map { "$prefix$_" } map {join q{}, @{$_}; } @permutations)[0 .. 9];
In case you are wondering, the first 10 pandigital numbers are:
1023456789 1023456798 1023456879 1023456897 1023456978 1023456987 1023457689 1023457698 1023457869 1023457896
Challenge 2:
Distinct Terms Count
You are given 2 positive numbers,
$mand$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
A similar problem was posed almost two years agoi in PWC 33 Challenge 2 so I was able to reuse some code. As in that one, the biggest issue in this challenge is getting all the formatting looking right.
To get the columns lined up, we need the maximum length of $m, $n, and the biggest term.
my $mlength = $m.chars;
my $nlength = $n.chars;
my $mnlength = ($m * $n).chars;
We also need a hash where the keys will be the terms, and the values will be the number of times each term was seen.
my %terms;
These two lines, print the table header:
say sprintf("% {$mlength + 2}s", 'x |'),
(1 .. $n).fmt("% {$mnlength}s", q{ });
say q{-} x $mlength + 1, q{+}, q{-} x ($n * ($mnlength + 1) - 1);
...Then for each value of $m we print it as the y-axis label:
for (1 .. $m) -> $em {
printf("% {$mlength}s |", $em);
...and multiply it by each of the $n values. This answer is stored in the %terms hash and printed:
for (1 .. $n) -> $en {
my $term = $em * $en;
%terms{$term}++;
printf("% {$mnlength}s ", $term);
}
...a newline is printed to end the row:
print("\n");
}
...and one more to separate the table from outher output:
print("\n");
The keys of %terms will be the distinct terms. We print them separated by commas:
say 'Distinct Terms: ', %terms.keys.sort({ $^a <=> $^b }).join(q{, });
...The count of keys is how many distinct terms we have:
say 'Count: ', %terms.keys.elems;
This is the Perl version. It works the same way but it is somewhat more verbose.
my $mlength = length $m;
my $nlength = length $n;
my $mnlength = length ($m * $n);
my %terms;
say q{}, (sprintf "% ${\($mlength + 2)}s", 'x |'),
map { sprintf "% ${\($mnlength)}s ", $_} 1 .. $n;
say q{-} x ($mlength + 1), q{+}, q{-} x ($n * ($mnlength + 1) - 1);
for my $em (1 .. $m) {
printf "% ${\($mlength)}s |", $em;
for my $en (1 .. $n) {
my $term = $em * $en;
$terms{$term}++;
printf "% ${\($mnlength)}s ", $term;
}
print "\n";
}
print("\n");
say 'Distinct Terms: ', join q{, }, sort { $a <=> $b } keys %terms;
say 'Count: ', scalar keys %terms;