In 1949, Indian mathematician D.R. Kaprekar from Devlali (Nashik) came up with an interesting routine, the procedure now known as Kaprekar routine. This routine when applied to any positive four digit number [all the digits should not be similar], converges to the same number 6174 in at most seven steps. To understand the routine, let us follow this procedure:

Take any four digit number [in base 10], let’s say 1234.
Arrange these digits in descending order. [In our example, it will be 4321]
Now rearrange the digits in ascending order [i.e. 1234]
Subtract the smaller number from bigger to get a new number.
Repeat the above procedure for each new number you get.

Let us work out with our first example.

1) 4321 - 1234 = 3087
2) 8730 - 0378 = 8352
3) 8532 - 2358 = 6174
4) 7641 - 1467 = 6174

When we reach the number 6174, the operation repeats itself, returning 6174 every time. This 6174 number is known as Kaprekar constant.

Let’s try with another number- How about this year as four digit number- 2014

1) 4210 - 0124 = 4086
2) 8640 - 0468 = 8172
3) 8721 - 1278 = 7443
4) 7443 - 3447 = 3996
5) 9963 - 3699 = 6264
6) 6642 - 2466 = 4176
7) 7641 - 1467 = 6174

First example [1234] reached the number 6174 in 3 steps while the second one [2014] reached in 7 steps. In fact all the four digit numbers reach the mysterious number 6174 at most 7 steps. This is the beauty of Kaprekar constant.

Now there are 10000 four digit numbers. How many iterations would be required for every number to reach a fixed point ? Let us try to find out.

In Mathematica, we will write a function called kaprekar which will calculate the number of iterations required for any four digit number to reach the kaprekar constant 6174:

kaprekar[n_Integer] := 
            Module[{a = Rest[Most[FixedPointList
        [(FromDigits[Reverse[Sort[IntegerDigits[#, 10, 4]]]] - FromDigits[Sort
  [IntegerDigits[#, 10, 4]]]) &, n]]]},LengthWhile[a, # > 0 &]]  

(Note that numbers having fewer than 4 digits are padded with leading 0s, i.e. 1 will be written as 1000 or 41 will be 4100.)

Let’s check for the number 2014:

kaprekar[2014] = 7 

Indeed as we have seen earlier, the number 2014 takes 7 steps to reach a fixed value. Now we will run this program for every number from 0 to 10000 to determine the number of iterations to reach kaprekar constant.

We will arrange these numbers into a 100 x 100 grid and assign a specific color to each of these numbers.

Colors assigned to the no. of iterations to reach Kaprekar constant

Data = Partition[kaprekar[#] & /@ Range[0, 10000], 100]; 
(* Map each value to a specific color *)

colors={0 -> RGBColor[1, 1, 1], 1 -> RGBColor[1, 6/7, 0], 
 2 -> RGBColor[2/7, 1, 0], 3 -> RGBColor[0, 1, 4/7], 
 4 -> RGBColor[0, 4/7, 1], 5 -> RGBColor[2/7, 0, 1], 
 6 -> RGBColor[1, 0, 6/7], 7 -> RGBColor[1, 0, 0]};

ArrayPlot[Reverse[Data], ColorRules -> colors, ImageSize -> 800, Mesh -> All, 
MeshStyle -> Black, Frame -> True, 
FrameTicks -> {{Range[0, 100, 20], None}, {Range[0, 100, 20], None}}, 
DataRange -> {{0, 99}, {0, 99}}, 
BaseStyle -> Directive[FontFamily -> "Gill Sans", 12], FrameLabel -> 
TraditionalForm /@ {Floor[n/100], Mod[n, 100]}]

The number of steps required for the Kaprekar routine to reach a fixed point for values of n = 0 to 9999, partitioned into rows of length 100. Numbers having fewer than 4 digits are appended with leading 0s, resulting in all values converg… — The number of steps required for the Kaprekar routine to reach a fixed point for values of *n = 0* to 9999, partitioned into rows of length 100. Numbers having fewer than 4 digits are appended with leading 0s, resulting in all values converging to 6174.

This figure was first appeared on the cover page of Mathematics Teacher [Math. Teacher 98, 234-242, 2004].

Now let’s put green color to the even numbers in the above figure and blue color to the odd numbers.

ArrayPlot[Reverse[Data], ColorRules -> {_?EvenQ -> Green, _?OddQ -> Blue}, 
ImageSize -> 800, Mesh -> All, MeshStyle -> Black, Frame -> True, 
FrameTicks -> {{Range[0, 100, 20], None}, {Range[0, 100, 20], None}},
DataRange -> {{0, 99}, {0, 99}}, 
BaseStyle -> Directive[FontFamily -> "Gill Sans", 12],
FrameLabel -> TraditionalForm /@ {Floor[n/100], Mod[n, 100]}]

Even numbers are c… — Even numbers are colored in green while odd ones are blue colored.

How about coloring the prime numbers as green and rest of them as blue? What kind of pattern does it show? Let's find out-

ArrayPlot[Reverse[Data], 
ColorRules -> {_?PrimeQ -> Green, Except[_?PrimeQ] -> Blue}, 
ImageSize -> 800, Mesh -> All, MeshStyle -> Black, Frame -> True, 
FrameTicks -> {{Range[0, 100, 20], None}, {Range[0, 100, 20], None}},
DataRange -> {{0, 99}, {0, 99}}, 
BaseStyle -> Directive[FontFamily -> "Gill Sans", 12],
FrameLabel -> TraditionalForm /@ {Floor[n/100], Mod[n, 100]}]

Prime numbers are colored as green while rest o… — Prime numbers are colored as green while rest of the numbers are colored as blue.

Now how about making Kaprekar music. There are some wonderful attempts to convert the digits of mathematical constant Pi to musical sequence [check Michael John Blake- A musical interpretation of pi, and Lucy Kaplansky - Song About Pi]. The major scale consists of 7 notes from any chromatic scale and we have already seen that the Kaprekar constant can be reached at the most 7 iterations. We will assign a note to each number [i.e. iterations needed to reach 6174] and play the musical sequence. Let us try on the sequence of numbers generated in the Kaprekar routine for first 100 numbers.

Sound[SoundNote[#] & /@ (kaprekar[#] & /@ Range[100]), 20]

Sounds nice. Now let's quantize the audio with the parameter 1/16 Swing D. [I used Garageband for this.]

Now we will find out the sequence of Kaprekar transformations leading to 6174 in all four digit numbers.

kaprekarSequence[x_] := 
        Rest[Most[
        FixedPointList[(FromDigits[Reverse[Sort
        [IntegerDigits[#, 10, 4]]]] - 
        FromDigits[Sort[IntegerDigits[#, 10, 4]]]) &, x]]]; 

data = Partition[#, 2, 1] & /@(kaprekarSequence[#] & /@ Range[10000]);  
rules = Map[Apply[Rule, #] &, data, {2}];
kpSequence = Cases[Tally[Rules], {x_List, y_} -> x]; 

TreePlot[Flatten[kpSequence], ImageSize -> 1000, 
VertexRenderingFunction -> ({White, EdgeForm[LightGray], Disk[#, {.2, .125}], 
Black, Text[#2, #1]} &), PlotStyle -> Orange, 
BaseStyle -> {FontFamily -> "Gill Sans", 12}] 

Flow chart for Kaprekar sequence for four digit numbers [in … — Flow chart for Kaprekar sequence for four digit numbers [in base 10]

We can find the frequency of each route by-

bardata = 
Sort[Cases[ Tally[kaprekarSequence[#] & /@Range[10000]], 
{x_List, y_} /; Length[x] > 0 && First[x] != 0 :> {Length[x], First[x], y}]] 

values = Split[bardata, First[#1] === First[#2] &] 

BarChart[values[[#]][[All, 3]] & /@ Range[7, 1, -1], BarOrigin -> Left, 
AspectRatio -> 0.9, ChartBaseStyle -> EdgeForm[LightGray],
ChartStyle -> {{Red, Orange, Blue, Gray, Magenta, Purple}, None}, 
ImageSize -> 800, BaseStyle -> {FontFamily -> "Gill Sans", 10},  
PlotRange -> {{0, 500}, Automatic}, Ticks -> {Range[0, 500, 100], Automatic},
BarSpacing -> Medium]  

Frequency of Kaprekar sequence  for four digit numbers [in base 10]. The numbers at the left denotes the number of steps required to reach the Kaprekar constant. — Frequency of Kaprekar sequence for four digit numbers [in base 10]. The numbers at the left denotes the number of steps required to reach the Kaprekar constant.

References

Kaprekar DR (1955). An Interesting Property of the Number 6174. Scripta Mathematica, 15:244-245.
Kaprekar DR (1980). On Kaprekar Numbers. Journal of Recreational Mathematics, 13(2):81-82.
Deutsch, D. and Goldman, B. (2004). Kaprekar's Constant. Mathematics Teacher 98: 234-242.