# 6174-Kaprekar's Constant

#### erco

##### Senior Member
Just saw this interesting math process which always converges on the value 6174. Might make a good learning challenge for Picaxe students to teach data input and sorting. Certainly a piece of cake for us Picaxe fanboys! Code could be run in the simulator without any Picaxe hardware at all.

#GeeklyHub Mystery of the Kaprekar's Constant (youtube.com)

#### papaof2

##### Senior Member
You have already whipped out the code for an 08M2 driving a 4 line by 20 character display and either a keypad or a set of pushbuttons (or touch switches) labeled 0 through 9 plus Delete, Backspace and Compute, haven't you? ;-)

Then the next contest will be whose code can do it the fastest.

And the contest after that will be who can write the smallest code to display the sequence to the constant.
.

Last edited:

#### erco

##### Senior Member
I like the way you think, papaof2!

#### Aries

##### New Member
This is my take on it. Rather than use a conventional sort, as there are only 4 values, I find the min and max using the Picaxe functions, pass through looking for where they are, pack the remaining ones (leaving two) and then do another MIN/MAX to get the order.
Code:
``````symbol value = 100

w10 = 6542
poke value,word w10

peek value,word w10                                                    ' load initial value into w10

do

' extract digits (b0 = least significant)
b0 = w10 // 10
b1 = w10 / 10 // 10
b2 = w10 / 100 // 10
b3 = w10 / 1000

sertxd(13,10,#w10)
b10 = b0 MAX b1 MAX b2 MAX b3                                ' overall min
b13 = b0 MIN b1 MIN b2 MIN b3                                ' overall max
if b10 = b13 then
sertxd(13,10,"*ERROR* all digits are the same")
end
endif

' pack b0 to b3 to remove min/max entries
b16 = b10                                                                        ' set to min
do
bptr = 0
do
if @bptrinc = b16 then                                    ' found min
do
b15 = bptr - 1
poke b15,@bptrinc
loop until bptr > 3
exit
endif
loop
if b16 = b13 then exit                                        ' completed second pass
b16 = b13                                                                    ' set to max
loop

b11 = b0 MAX b1                                                            ' second smallest
b12 = b0 MIN b1                                                            ' second largest

w13 = w10                                                                        ' current value
w11 = b13 * 10 + b12 * 10 + b11 * 10 + b10    ' largest number
w12 = b10 * 10 + b11 * 10 + b12 * 10 + b13    ' smallest number

w10 = w11 - w12
sertxd(" -> ",#w11,"-",#w12," = ",#w10)
if w10 = w13 then exit
loop``````
Result:
Code:
``````6542 -> 6542-2456 = 4086
4086 -> 8640-468 = 8172
8172 -> 8721-1278 = 7443
7443 -> 7443-3447 = 3996
3996 -> 9963-3699 = 6264
6264 -> 6642-2466 = 4176
4176 -> 7641-1467 = 6174
6174 -> 7641-1467 = 6174``````

#### erco

##### Senior Member
A lovely solution, Aries. Great job! I'll have to get back to my unfinished code, hopefully not stealing too much from yours.

#### hippy

##### Ex-Staff (retired)
Just saw this interesting math process which always converges on the value 6174. Might make a good learning challenge for Picaxe students to teach data input and sorting.
That is something I had never heard of before and very interesting.

The challenges do seem to be input, checking the digits aren't all the same, and particularly sorting.

For checking the digits aren't all the same one can either split into digits then compare them against each other, or check the number isn't 0000, 1111, 2222 through 9999 which could be done quite compactly with a LOOKDOWN command.

Sorting is the challenging one. I went with a Bubble Sort. My 'd1' is most significant (highest value) digit, 'd4' the least significant (lowest value) digit, flagged any swapping and repeated until there was none ...
Code:
``````SortDigitsIntoDescendingOrder:
Do
swapped = False
if d1 < d2 Then : dX = d1 : d1 = d2 : d2 = dX : swapped = True : End If
if d2 < d3 Then : dX = d2 : d2 = d3 : d3 = dX : swapped = True : End If
if d3 < d4 Then : dX = d3 : d3 = d4 : d4 = dX : swapped = True : End If
Loop Until swapped <> True
Return``````
That will loop a maximum of three times in the worst case ...
Code:
``````1234 -> 2134 -> 2314 -> 2341
2341 -> 3241 -> 3421 -> 3421
3421 -> 4321 -> 4321 -> 4321``````
Because we are progressively ensuring the lowest value digits are in the lowest digit positions that allows for a nice unrolling of the loop which will speed things up ...
Code:
``````SortDigitsIntoDescendingOrder:
if d1 < d2 Then : dX = d1 : d1 = d2 : d2 = dX : End If
if d2 < d3 Then : dX = d2 : d2 = d3 : d3 = dX : End If
if d3 < d4 Then : dX = d3 : d3 = d4 : d4 = dX : End If
; d4 must now be lowest
if d1 < d2 Then : dX = d1 : d1 = d2 : d2 = dX : End If
if d2 < d3 Then : dX = d2 : d2 = d3 : d3 = dX : End If
; d3 must now be correct
if d1 < d2 Then : dX = d1 : d1 = d2 : d2 = dX : End If
Return``````
Swapping the digits could be done with SWAP for those PICAXE which have it, and one could also use the magic XOR sequence, for example to swap 'd1' with 'd2' ...
Code:
``````d1 = d1 Xor d2
d2 = d1 Xor d2
d1 = d1 Xor d2``````
That this XOR sequence does work never ceases to amaze me.

It would probably be worth putting the swapping in a #MACRO so it can be easily changed to try various techniques ...
Code:
``````#Macro SWAP_IF_NEEDED(hi, lo)
If hi < lo Then
dX = hi : hi = lo : lo = dX
End If
#endMacro

SortDigitsIntoDescendingOrder:
; d1 is msd, d4 is lsd
SWAP_IF_NEEDED(d1, d2)
SWAP_IF_NEEDED(d2, d3)
SWAP_IF_NEEDED(d3, d4)
; d4 must now be lowest
SWAP_IF_NEEDED(d1, d2)
SWAP_IF_NEEDED(d2, d3)
; d3 must now be correct
SWAP_IF_NEEDED(d1, d2)
Return``````

And the contest after that will be who can write the smallest code to display the sequence to the constant.
Smallest code, fastest code, most understandable code, most elegant code, are all in the running there.

#### AllyCat

##### Senior Member
Hi,
The challenges do seem to be input, checking the digits aren't all the same, and particularly sorting.
The reason that the digits must not all be the same is that the sorted "high" and "low" numbers would both be the same, so the subtraction produces zero. I just allowed the basic program to run, trapped the zero and printed an "Error Message" in place of the zero.

I think I created a "bubble sort" for digits in b4 - b7. Maybe not the fastest but only around 50 program bytes. Incidentally PE6 rejected a SWAP @bptr , ... but actually the brute force arrangement (with an extra variable) uses less program bytes, so is probably faster.
Code:
``````symbol aptr = b0
symbol leftdig = b1
aptr = 4
bptr = 5
sort:
peek aptr,leftdig
if leftdig <= @bptr then                ; Move right
if bptr > 6 then sorted
inc aptr : inc bptr
goto sort
else
;        swap @bptr,leftdig
b20 = @bptr                                ; Cannot use SWAP @bptr in PE6 (PE5 is happy)
@bptr = leftdig                        ; But this uses less bytes !
leftdig = b20
poke aptr,leftdig
if aptr > 4 then                        ; Move left
dec aptr : dec bptr
endif
goto sort
endif
sorted:``````
I was "lazy" and just used standard routines to convert the 4 digits to/from Word variables, but I think the best arrangement might be to write a digit-by-digit subtraction routine (i.e. directly in b4 to b7) and for the I/O. That would retain any leading zeros in the I/O formatting without the need for "additional code". My total program was about 150 bytes, but it's usually the neat formatting and additional text that adds enormously to a program's size.

Then I extended the program to produce a "histogram" for the number of iterations to reach the terminal value. Interestingly 3 , 4 , 5 , 6 and 7 iterations occur in almost equal numbers, but I didn't test all 10,000 numbers, since Wikipedia says that 7 is the maximum number.

Cheers, Alan.

#### Aries

##### New Member
Without the setting of value at the start, and without any of the sertxd statements, mine comes in at 147 bytes.
The test for all-equal digits is a trivial consequence of using MIN and MAX - if they are the same, then all the digits are the same.

#### erco

##### Senior Member
Way to dive in, Team Picaxe! This thread is drawing some eyes with serious talent. Nice to see interest and various approaches.

Mods, maybe you should throw out a monthly challenge along these lines.

#### hippy

##### Ex-Staff (retired)
The test for all-equal digits is a trivial consequence of using MIN and MAX - if they are the same, then all the digits are the same.
Sorry; I had missed that as an option and it is a very neat trick.

Given 'a XOR b' will give a zero result when both are the same I was wondering if something like 'a XOR b XOR c XOR d' would work, but it doesn't., only works for pairs. But I did get to this ...
Code:
``````x = a ^ b
x = b ^ c | x
x = c ^ d | x
If x = 0 Then : SerTxd("Digits all the same")``````
Not sure if that's better, faster, smaller. Nor sure if it could be optimised further.

'a MINUS b' is also only zero when the same, so perhaps there's some trick with that, or MINUS with XOR, or in an IF comparison. I'll need to have a think on that.

#### hippy

##### Ex-Staff (retired)
Then I extended the program to produce a "histogram" for the number of iterations to reach the terminal value. Interestingly 3 , 4 , 5 , 6 and 7 iterations occur in almost equal numbers, but I didn't test all 10,000 numbers, since Wikipedia says that 7 is the maximum number.
Seems Wikipedia is right, testing all valid numbers ...
Code:
``````1 loop  = 384     ********
2 loops = 576     ************
3 loops = 2400    ************************************************
4 loops = 1272    *************************
5 loops = 1518    ******************************
6 loops = 1656    *********************************
7 loops = 2184    ********************************************``````
There are only 9990 numbers because of the ten 'all the same digits'. But are there ?

Should we consider 1234, 2134, 2314, etc, all 24 numbers which give the same initial descending and ascending values, as the same ... ?

abcd -> 4321-1234 = 3087

But it's only 24 the same when the digits are all unique. 1112 only has 4 combinations, 1122 only 6.

Not sure it matters much but does show how 'statistics', the histogram, may be considerably influenced by how we define the test set.

#### papaof2

##### Senior Member
I love watching fertile minds get the seed of a new idea dropped in and then it quickly grows and flowers - although some of the flowers are much larger (or is it smaller?) than others ;-)

Keep up the ideas - even if I never program this process on a PICAXE, I'm seeing lots of ways of creating equivalent tests.

#### hippy

##### Ex-Staff (retired)
It seems to me there are only 705 unique descending digit numbers and -
Code:
``````1 loop  = 20      *****
2 loops = 34      *********
3 loops = 140     ***********************************
4 loops = 129     ********************************
5 loops = 113     ****************************
6 loops = 153     **************************************
7 loops = 116     *****************************``````