随想飞翔

这是一个1949年提出的问题。

任何一个不全相同的四位数，其逆序排列减去顺序排列的结果再循环进行这个运算（结果不足四位补零），最终结果都为6174。

这里有一篇很详细的研究，包括需要几次运算，其它位数的数字等等。大家开着金山词霸就可以搞定:)

下面给出VBScript演示程序。
其中包括一个冒泡排序算法，还有很少用到的Join函数（组合数组）和StrReverse函数（字符串翻转）。

看代码前请大家先考虑如下问题：
1.如何判断一个四位数是否为AAAA型？如1111、2222、5555等。
2.至少执行一次的不定次数循环用哪个循环语句？

惊喜的发现把服务器端代码中Response.Write改成Document.Write就可以了。

客户端

仅支持IE内核
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> <script language="VBScript"> 'Kaprekar变换演示程序 'By Cloudream ,转载请保留此版权信息 'http://www.5iya.com/blog/post/Kaprekar.asp Dim intOrigin,intASCOrdered,intDESCOrdered,x,intPrevious,z '获得四位不全相同的自然数 Do intOrigin = GetRandom(1000,9999) Loop While InStr(CStr(intOrigin / 1111),".") < 1 x = intOrigin Write "随机数:" & x z = 0 Do z = z + 1 intPrevious = x '补足不够4位的差值 x = Right("0000"&CStr(x),4) intASCOrdered = GetASCOrder(x) intDESCOrdered = StrReverse(intASCOrdered) x = CLng(intDESCOrdered) - CLng(intASCOrdered) Write z & ". " & intDESCOrdered & " - " & intASCOrdered & " = " & x Loop While x <> intPrevious Function GetASCOrder(ByVal intNumber) '功能:冒泡排序 '参数:未排序数字 Dim intLen,i,k,n,p intLen = Len(intNumber) ReDim arrNumber(intLen) '读取每位数字到一个数组元素 For i = 1 To intLen arrNumber(i) = Mid(intNumber,i,1) Next For k = 1 To intLen For n = 1 To (intLen-k) If arrNumber(n) > arrNumber(n+1) Then p = arrNumber(n) arrNumber(n) = arrNumber(n+1) arrNumber(n+1) = p End If Next Next GetASCOrder = Join(arrNumber,Empty) End Function Function GetRandom(ByVal intMin,intMax) '功能:取得随机整数 '参数:最小值,最大值 Dim intNumber Randomize intNumber = Fix(Rnd * (intMax - intMin + 1)) + intMin GetRandom = intNumber End Function Function Write(ByVal strCode) '功能:输出换行信息 '参数:待输出信息 Document.Write strCode & "<br />" End Function </script>
[ 可以先修改再运行 ]

服务器端（ASP）

请保存为asp文件，在IIS服务器下浏览访问。
<%@ LANGUAGE="VBScript" CODEPAGE=65001 %> <% Option Explicit Response.CodePage = 65001 Response.Charset = "UTF-8" Dim intOrigin,intASCOrdered,intDESCOrdered,x,intPrevious,z 'Kaprekar变换演示程序 'By Cloudream ,转载请保留此版权信息 'http://www.5iya.com/blog/post/Kaprekar.asp '获得四位不全相同的自然数 Do intOrigin = GetRandom(1000,9999) Loop While InStr(CStr(intOrigin / 1111),".") < 1 x = intOrigin Write "随机数:" & x z = 0 Do z = z + 1 intPrevious = x '补足不够4位的差值 x = Right("0000"&CStr(x),4) intASCOrdered = GetASCOrder(x) intDESCOrdered = StrReverse(intASCOrdered) x = CLng(intDESCOrdered) - CLng(intASCOrdered) Write z & ". " & intDESCOrdered & " - " & intASCOrdered & " = " & x Loop While x <> intPrevious Function GetASCOrder(ByVal intNumber) '功能:冒泡排序 '参数:未排序数字 Dim intLen,i,k,n,p intLen = Len(intNumber) ReDim arrNumber(intLen) '读取每位数字到一个数组元素 For i = 1 To intLen arrNumber(i) = Mid(intNumber,i,1) Next For k = 1 To intLen For n = 1 To (intLen-k) If arrNumber(n) > arrNumber(n+1) Then p = arrNumber(n) arrNumber(n) = arrNumber(n+1) arrNumber(n+1) = p End If Next Next GetASCOrder = Join(arrNumber,Empty) End Function Function GetRandom(ByVal intMin,intMax) '功能:取得随机整数 '参数:最小值,最大值 Dim intNumber Randomize intNumber = Fix(Rnd * (intMax - intMin + 1)) + intMin GetRandom = intNumber End Function Function Write(ByVal strCode) '功能:输出换行信息 '参数:待输出信息 Response.Write strCode & "<br />" End Function %>
[ 可以先修改再运行 ]