Perl Weekly Challenge: Week 357
Challenge 1:
Kaprekar Constant
Write a function that takes a 4-digit integer and returns how many iterations are required to reach Kaprekar’s constant (6174). For more information about
Kaprekar's Constantplease follow the wikipedia page.
Example 1
Input: $int = 3524
Output: 3
Iteration 1: 5432 - 2345 = 3087
Iteration 2: 8730 - 0378 = 8352
Iteration 3: 8532 - 2358 = 6174
Example 2
Input: $int = 6174
Output: 0
Example 3
Input: $int = 9998
Output: 5
Iteration 1: 9998 - 8999 = 0999
Iteration 2: 9990 - 0999 = 8991
Iteration 3: 9981 - 1899 = 8082
Iteration 4: 8820 - 0288 = 8532
Iteration 5: 8532 - 2358 = 6174
Example 4
Input: $int = 1001
Output: 4
Iteration 1: 1100 - 0011 = 1089
Iteration 2: 9810 - 0189 = 9621
Iteration 3: 9621 - 1269 = 8352
Iteration 4: 8532 - 2358 = 6174
Example 5
Input: $int = 9000
Output: 4
Iteration 1: 9000 - 0009 = 8991
Iteration 2: 9981 - 1899 = 8082
Iteration 3: 8820 - 0288 = 8532
Iteration 4: 8532 - 2358 = 6174
Example 6
Input: $int = 1111
Output: -1
The sequence does not converge on 6174, so return -1.
We start by bringing in $int from the command-line. Departing from usual practice
we add the is copy trait to make it mutable.
As per the Wikipedia article, Kaprekar's Constant is 6174. We define it here for later use.
constant KAPREKAR = 6174;
The count of iterations is defined here.
my $count = 0;
Now until $int converges on Kaprekar's constant...
while $int != KAPREKAR {
As the Wikipedia article explains, if during an iteration, the value of $int goes to 0,
it will never converge so we just set $count to -1 and stop processing.
if $int == 0 {
$count = -1;
last;
}
Otherwise we take $int, split it into individual digits with .comb(), .sort() them in
ascending order and join them together again. A key task is to make sure $int remains 4 digits
long. If in any iteration it is shorter than that, we have to pad it with the appropriate number of 0s.
sprintf("%04d") will handle that.
The result of all this will be the "smaller" of the two values needed to calculate the next iteration of $int.
my $smaller = sprintf("%04d", $int.comb.sort.join);
To find the "larger" value, we just reverse the smaller value with .flip().
my $larger = $smaller.flip;
The next iteration of $int is calculated by subtracting the smaller value from the larger.
$int = $larger - $smaller;
The number of iterations is increased by one.
$count++;
}
Finally we print the number of iterations.
say $count;
This is the Perl version. For once we do not need any extra features or functions which are not present in Perl itself.
use constant KAPREKAR => 6174;
my ($int) = @ARGV;
my $count = 0;
while ($int != KAPREKAR) {
if ($int == 0) {
$count = -1;
last;
}
my $smaller = sprintf("%04d", join q{}, sort split //, $int);
my $larger = reverse $smaller;
$int = $larger - $smaller;
$count++;
}
say $count;
Challenge 2:
Unique Fraction Generator
Given a positive integer N, generate all unique fractions you can create using integers from 1 to N and follow the rules below:
- Use numbers 1 through N only (no zero)
- Create fractions like numerator/denominator
- List them in ascending order (from smallest to largest)
- If two fractions have the same value (like 1/2 and 2/4),
only show the one with the smallest numerator
Example 1
Input: $int = 3
Output: 1/3, 1/2, 2/3, 1/1, 3/2, 2/1, 3/1
Example 2
Input: $int = 4
Output: 1/4, 1/3, 1/2, 2/3, 3/4, 1/1, 4/3, 3/2, 2/1, 3/1, 4/1
Example 3
Input: $int = 1
Output: 1/1
Example 4
Input: $int = 6
Output: 1/6, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4,
4/5, 5/6, 1/1, 6/5, 5/4, 4/3, 3/2, 5/3, 2/1,
5/2, 3/1, 4/1, 5/1, 6/1
Example 5
Input: $int = 5
Output: 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1/1,
5/4, 4/3, 3/2, 5/3, 2/1, 5/2, 3/1, 4/1, 5/1
The X operator provides the cross product of its operands. What this means is that we
will get $int2 two element arrays where each element is a number from 1 to $int. These
arrays will be treated as fractions where the first element represents the numerator and the second element
represents the denominator.
((1 .. $int) X (1 .. $int))
For each array/fraction we find the greatest common denominator of its elements (Raku has a gcd operator for that.)
We simplify each fraction by dividing each element by this greatest common denominator. Thus (4 2) would become (2 1),
(3 6) would become (1 2) and so on.
.map({ my $gcd = $_[0] gcd $_[1]; [$_[0] / $gcd, $_[1] / $gcd] })
Then we .sort() the fractions in terms of ascending size.
.sort({ $^a[0] / $^a[1] <=> $^b[0] / $^b[1] })
With another .map(), the arrays are transformed into strings.
.map({ "$_[0]/$_[1]" })
.unique() is used to remove duplicate values.
.unique
The results are .join()ed together with commas and spaces and printed with .say().
.join(", ")
.say;
For the Perl version we need to provide our own versions of X(), unique() and gcd() which I already had from previous challenges.
One problem I had was my version of unique() didn't maintain list order which is necessary for this problem.
sub unique(@list) {
my %elems;
for (@list) {
$elems{$_}++;
}
Originslly I just returned the keys of %elems. The problem is keys() returns the keys of a hash in random order (for
security reasons I believe.) Instead I changed it to this which goes through @listand returns elements from it only if the value of their keys in %elems is 0; otherwise it decrements the value by 1. This way we still get unique values but the list order is kept.
return grep { --$elems{$_} == 0 } @list;
}
Once we include all these functions, we can follow the same algorithm as in Raku. You'll notice the order of operations is reversed though.
say join q{, },
unique(
map { "$_->[0]/$_->[1]" }
sort { ($a->[0] / $a->[1]) <=> ($b->[0] / $b->[1]) }
map { my $gcd = gcd($_->[0], $_->[1]); [$_->[0] / $gcd, $_->[1] / $gcd] }
X([1 .. $int], [1 .. $int])
);