6174-Kaprekar's Constant

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:
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
 
A lovely solution, Aries. Great job! I'll have to get back to my unfinished code, hopefully not stealing too much from yours. :)
 
erco said:
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.
Click to expand...
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

papaof2 said:
And the contest after that will be who can write the smallest code to display the sequence to the constant.
Click to expand...
Smallest code, fastest code, most understandable code, most elegant code, are all in the running there.
 
Hi,
hippy said:
The challenges do seem to be input, checking the digits aren't all the same, and particularly sorting.
Click to expand...
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.
 
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.
 
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.
 
Aries said:
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.
Click to expand...
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.
 
AllyCat said:
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. ;)
Click to expand...
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.
 
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.
 
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     *****************************
 
You must log in or register to reply here.
Back
Top