Quick Tip #13: Kapreker’s Constant

A Kaprekar’s Constant is the number you end up with when you repeatedly substract the descending digits of a four digit number from the ascending digits. This is mostly a problem with rearranging characters.

Here’s the process:

  • Start with a four digit number that has at least two different digits. Zero-pad if necessary.
  • Get the number formed from the ascending digits, and the number formed from the descending digits.
  • Subtract the ascending from the descending to get the starting number for the next round.
  • Do it again. You shouldn’t have to do this more than seven times.

Perl 6 has some nice methods in the Str class. The comb method turns a string into a list of its characters. Once I have a list, it’s a matter of sorting the digits and putting them back together.

I use the signature for the MAIN subroutine to grab a number from the command line and force it to be in the right range. Perl 6 has the nice syntax to check that a number is between two others that uses the variable once.

I also put the list of digits into a set so I can check if there is more than one thing (set members are unique).

sub MAIN ( Int $n where { 0 < $_ <= 9999 and set( $n.comb ).elems > 1 } ) {
	my $previous = '0000';

	# pad small numbers with zero to maintain 4 digits in $descending
	# we treat numbers as strings of digits rather than values
	my $next = sprintf "%04d", $n;

	while ( $next != 0 ) {
		my $descending = $next.comb.sort.reverse.join;
		my $ascending  = $next.comb.sort.join;
		$next = sprintf "%04d", $descending - $ascending;
		say "$descending - $ascending = $next";
		last if $next eq $previous;
		$previous = $next;
		}
	}

When I run this with a number that fits the conditions, it quickly turns into 6174, and that’s Kaprekar’s Constant:

$ perl6 kaprekar_numbers.p6 8881
8881 - 1888 = 6993
9963 - 3699 = 6264
6642 - 2466 = 4176
7641 - 1467 = 6174
7641 - 1467 = 6174

If I try to pass invalid input, the MAIN doesn’t run. Instead, an implied USAGE spits out a vague message:

$ perl6 kaprekar_numbers.p6
Usage:
  kaprekar_numbers.p6 <n>
$ perl6 kaprekar_numbers.p6 abc
Usage:
  kaprekar_numbers.p6 <n>
$ perl6 kaprekar_numbers.p6 1
Usage:
  kaprekar_numbers.p6 <n>

I could define my own USAGE, but I’ll save that for another Quick Tip.

Leave a Reply

Your email address will not be published. Required fields are marked *