| 23 January 2026 | Challenge 357 |
Fractional Fix Points
Task 1: Kaprekar Constant
Submitted by: Mohammad Sajid Anwar
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 Constant please 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.
Solution
As the task may be generalized to different bases and length, these values are extracted as constants B and L.
The first building block is a function that performs the Kaprekar procedure on a given number:
- take the last
Ldigits from the number’s representation in baseB - sort the digits
- convert the sorted and the reversed sorted digits back from base
B - calculate the difference between both numbers
This procedure is applied as long as input and output are different.
For B = 10, only L = 3 and L = 4 guarantee a fix point for the procedure, so there is limit of 20 as an emergency exit from the loop for the case when other values for B or L are used.
When the final result is non-zero, a Kaprekar fix point was reached.
Perl
The solution in Perl is straightforward.
use constant BASE => 10;
use constant LENGTH => 4;
sub kap ($x) {
my @s = sort +todigits($x, BASE, LENGTH);
fromdigits([reverse @s], BASE) - fromdigits([@s], BASE);
}
sub kaprekar ($x){
my ($y, $z) = (0, 0);
($x, $y, $z) = (kap($x), $x, $z + 1) while $x != $y && $z < 20;
die "not converging" if $z >= 20;
$x ? $z - 1 : -1;
}
See the full solution to task 1.
J
Though the logic is identical in J, it looks quiet different.
- the verbs
tdandfdoperate identical to their Perl counterpartstodigitsandfromdigits - the verb
kapoperates identical to the perl subkap - a loop in J is different:
- the verb
kaplimroughly corresponds to thewhileloop in thekaprekarsub and is applied until the termination1 Z: 1is called. - this condition is set in
kaplimwhen the result of a procedure step equals its input. - there is an emergency exit at 20 cycles set via
_3 Z: 20 - the verb
finalreturns_1if the final result is zero or otherwise the number of cycles that were completed (Z: 2)
- the verb
b =: 10
l =: 4
td =: (l $ b)&#:
fd =: b&#.
kap =: (-~&fd |.)@/:~@td
kaplim =: {{
_3 Z: 20
(] [ 1&Z:@=)/@(kap^:(<2)) y
}}
final =: {{_1:^:(0 = y) Z:2}}
kapcount =: final F. kaplim
echo kapcount 3524
See the full solution.
Task 2: Unique Fraction Generator
Submitted by: Yary
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
Solution
Perl
Using a tiny class Rat to represent positive fractions.
Only three methods are required:
- a constructor
frac(removing common factors) - a comparator
fcmpoverloading<=>and thus providing all comparison operators - a converter to string
fstroverloading""
All pairs \((d, n) \in \{1,\ldots,N\}^2\) are used to form fractions \(\frac{d}{n}\). The fractions are collected in a sorted array: A binary search detects the insertion index and the fraction is inserted if it is not yet at that position.
use strict;
use warnings;
use Math::Prime::Util 'forsetproduct';
package Rat;
use Math::Prime::Util 'gcd';
sub frac ($class, $n, $d) {
my $gcd = gcd $n, $d;
bless [map $_ / $gcd, $n, $d], $class;
}
sub fcmp ($self, $other, $swap) {
(-1)**!!$swap * ($self->[0] * $other->[1] <=> $other->[0] * $self->[1]);
}
sub fstr ($self, $, $) {
join '/', @$self;
}
use overload
'<=>' => \&fcmp,
'""' => \&fstr;
package main;
sub gen_frac ($n) {
my @frac;
forsetproduct {
my $f = Rat->frac(@_);
my $ix = @frac ? lower_bound {$_ <=> $f} @frac : 0;
splice @frac, $ix, 0, $f if $ix == @frac || $frac[$ix] != $f;
} ([1 .. $n]) x 2;
@frac;
}
See the full solution to task 2.
J
Using vectorized operations on rationals in J.
frac =: <@('/'&joinstring)@(8!:0)"1@(2&x:)@/:~@~.@,@(%/~)@(x:@>:@i.)
NB. H GGGGGGGGGGGGGG FFFF EE DDDD CCCCCCCC BBB AAAAAAAA
echo frac 5
+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
|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|
+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+
A: sequence of extended integers 1...y
B: matrix of all numerator/denominator (N/D) pairs from A as rationals
C: unique sort on rationals as array
D: convert rationals back to N/D pairs
E: apply left verb (F…H) on N/D pairs
F: convert from numeric to boxed strings
G: join with ‘/’
H: box fraction string
See the full solution.