Kaprekar's constant is the four-digit number 6174, which acts as a mathematical black hole for almost any four-digit number through a repeating routine.
Features of M2000 used for this program:
The queue type of inventory is like list but allow same keys. When we place a key without a value, the key is the value also (until we place another value for that key). The Exist() function can be used to check not only if a key exist but also how many times exist. Because the Inventory object (is a FastCollection object inside M2000 code) has two arrays, one for items (with some extra fields) and one for the hash table, when we place something with same hash stack in a linked list. So two same keys have always same hash and exist in same linked list, so we can find it very fast, and also very fast iterate through the linked list to count the same keys. A queue type of inventory can't delete a key except the last one each time (one or more from the last appended using Drop statement). Also a Sort keep the order of same keys as the insert. Using third parameter 0 in Exist() we get positive number, non zero, means there are one or more same keys. We can use Exist(queueName, key, i) when i =1 to Exist(queueName, Key,0) to get each item (using Eval(queueName) or Eval$(queueName)). This works using an index property of queue, so Exist() set the index to the real index of items array. From version 15 we can use all the #functions for arrays on the inventory (list or queue type). So we use #Str$("") to stringify all the items in one string. So we use Sort Ascending or Descending (as Number) and then using #Str$() we get the string and then using the Val() function we get the number. We do this for the two val1 and val2 and then we get val2-va1. Using a=right("000"+(val2-val1), 4) we get again a string with leading zero and 4 characters length.
For checking if the input string is as we want we use len() to check if it is 4 number/letters, then we use the filter() (use Help filter$() to see info about the function) dropping all numbers to check if the result has any length above 0 (so there are characters which are not digits). Then we place it in the queue and check if the first key has 4 items. If has 3 or less then we have at least 2 different.
We can make a queue type using Inventory Queue aName or aName=Queue Also, we can place keys and values: aName=Queue:=1,2,3,4 or Inventory Queue aName=1,2,3,4 (keys only, numbers or strings), or aName=Queue:=1:="one",2:="two",3:="three",4="four" or Inventory Queue aName=1:="one",2:="two",3:="three",4="four" (values can be anything including objects). So an Inventory may have inventories inside a cell. Do not place the same inventory as object (you waste memory if you not clear the item with the pointer to inventory).
Module kaprekar {
? "kaprekar's constant 4 digits (6174)"
string a
long steps=1
100 Input "4 digits - but at least two not the same:", a
if len(a)<>4 then
? "need 4 digits"
goto 100
end if
if len(filter(a,"0123456789"))>0 then
? "only digits allowed"
goto 100
end if
200 b=queue
for i=1 to 4: Append b, mid$(a,i,1): next
if exist(b, b#val$(0), 0)>3 then
? "need at least two different digits"
goto 100
end if
sort b as number
val1=val(b#str$(""))
sort descending b as number
val2=val(b#str$(""))
olda=a
a=right("000"+(val2-val1), 4)
? format("{0:0:-4} {1}", steps, a)
steps++
if a<>olda then 200
}
kaprekar
4 digits - but at least two not the same:abc1
only digits allowed
4 digits - but at least two not the same:1111
need at least two different digits
4 digits - but at least two not the same:1221
1 1089
2 9621
3 8352
4 6174
5 6174
Global Out$
Document Out$
Module kaprekar {
Enum Messages {
Crlf={
}
headTitle="kaprekar's constant 4 digits (6174)"
inputString="4 digits - but at least two not the same:"
need4digits="need 4 digits"
onlyDigitsAllowed="only digits allowed"
need2difdigits="need at least two different digits"
}
? headTitle
Out$<=headTitle+Crlf
string a
long steps=1
100 Print inputString;
Input "", a
Out$<=inputString+a+Crlf
if len(a)<>4 then
? need4digits
Out$<=need4digits+crlf
goto 100
end if
if len(filter(a,"0123456789"))>0 then
? onlyDigitsAllowed
Out$<=onlyDigitsAllowed+{
}
goto 100
end if
200 b=queue
for i=1 to 4: Append b, mid$(a,i,1): next
if exist(b, b#val$(0), 0)>3 then
? need2difdigits
Out$<=need2difdigits+Crlf
goto 100
end if
sort b as number
val1=val(b#str$(""))
sort descending b as number
val2=val(b#str$(""))
olda=a
a=right("000"+(val2-val1), 4)
Out$<=format("{0:0:-4} {1}", steps, a)+{
}
steps++
if a<>olda then 200
}
kaprekar
report Out$
clipboard Out$
Δεν υπάρχουν σχόλια:
Δημοσίευση σχολίου
You can feel free to write any suggestion, or idea on the subject.