#### erco

##### Senior Member

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

- Thread starter erco
- Start date

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

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.

.

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:

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
```

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
```

That is something I had never heard of before and very interesting.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.

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
```

Code:

```
1234 -> 2134 -> 2314 -> 2341
2341 -> 3241 -> 3421 -> 3421
3421 -> 4321 -> 4321 -> 4321
```

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
```

Code:

```
d1 = d1 Xor d2
d2 = d1 Xor d2
d1 = d1 Xor d2
```

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
```

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

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.The challenges do seem to be input,checking the digits aren't all the same, and particularly sorting.

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

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:
```

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.

Sorry; I had missed that as an option and it is a very neat trick.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.

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")
```

'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.

Seems Wikipedia is right, testing all valid numbers ...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.

Code:

```
1 loop = 384 ********
2 loops = 576 ************
3 loops = 2400 ************************************************
4 loops = 1272 *************************
5 loops = 1518 ******************************
6 loops = 1656 *********************************
7 loops = 2184 ********************************************
```

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.

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

Code:

```
1 loop = 20 *****
2 loops = 34 *********
3 loops = 140 ***********************************
4 loops = 129 ********************************
5 loops = 113 ****************************
6 loops = 153 **************************************
7 loops = 116 *****************************
```