发一个算法 考考大家 （不难，但是有意思）

[mind_1220]

请写出100的阶乘结果的详细数字。

例如：100的阶乘的结果是：9.33262154439442E+157
但是不要用科学计数法表示。
我要的是：
933262154439441342545065203804399763456400347822004292163918007479219221080502693951550593085639738378274905995996983384058150646934473117340133360516676976
这样的结果。
看谁的算法最好。
限用ASP实现。
呵呵。。。

[wangyingdong]

学习一下！

[超级大笨狼]

<SCRIPT LANGUAGE="JavaScript">

var n=100;
var re=n;
test();
function test()
{
if(n!=1)
{
re = re * ( n-1) ;
n--;
test();
}
}

var s = re.toString();
var M = s.split("+")[1]
var t=0;
var p=0;
s=""
for(i=M;i>0;i--)
{
p = Math.pow(10,parseInt(i))
t = Math.floor(re/ p);
s+= t.toString();
re = re - t * p
}
alert(s);

</SCRIPT>

[超级大笨狼]

递归占一半，处理显示结果占代码一半。

[to_be_or_not_to_be]

难得大家这么有兴致，就发布一个1024个字符长度的整形数字加/减/乘运算，没有除法运算，也不兼容浮点数，有兴趣可以完善

Option Explicit

Const BIGINT_LENGTH = 1024'最大数字长度

Private Sub Debug(s)
WScript.echo s
End Sub

Public Function IsInt(s)'As boolean
s = CStr(s & "")
Dim sl: sl = Len(s)
IsInt = False
If sl=0 Then Exit Function
Dim i
i = IIf(Left(s, 1)="-" Or Left(s, 1)="+", 2, 1)
Do While i<=sl
Dim a: a = Mid(s, i, 1)
If IsNumeric(a)=False Then Exit Function
i = i + 1
Loop
IsInt = True
End Function

Public Function IIf(ex, ext, exf)
If ex Then
IIf = ext
Else
IIf = exf
End If
End Function

Class BIGINT
Public sign'是否有符号
Public buf'缓存

Private Sub Class_Initialize()
Dim i
sign = 0
ReDim buf(BIGINT_LENGTH)
For i=0 to BIGINT_LENGTH
buf(i) = 0
Next
End Sub

Private Sub Class_Terminat()
sign = 0
buf = ""
End Sub
End Class

'把字符或数字转为类
's，字符串或数字
Public Function bigint_import(s)'As BIGINT
Dim B: Set B = new BIGINT
s = CStr(s & "")
If IsInt(s) Then
B.sign = IIf(Left(s, 1)="-" Or Left(s, 1)="+", 1, 0)
Dim k: k = IIf(B.sign, 2, 1)
Dim i: i = BIGINT_LENGTH - Len(s) + k
Do While i<=BIGINT_LENGTH And k<=Len(s)
B.buf(i) = Int(Mid(s, k, 1))
k = k + 1
i = i + 1
Loop
End If
Set bigint_import = B
End Function

'把类转成字符串
'B，BIGINT
'sn，int，是否带符号输出，=0，不带，=1，带
Public Function bigint_export(B, sn)'As String
Dim i: i = 0
Dim tmp: tmp = ""
Do While i<=BIGINT_LENGTH
If B.buf(i)>0 Then Exit Do
i = i + 1
Loop
Do While i<=BIGINT_LENGTH
tmp = tmp & B.buf(i)
i = i + 1
Loop
If tmp="" Then tmp = "0"
bigint_export = IIf(B.sign And sn, "-", "") & tmp
End Function

'比较两个类的大小，不判断符号
'返回-1，PBO <PBT
'返回0，PBO = PBT
'返回1，PBO > PBT
Public Function intcmp(PBO, PBT)'As int
Dim bo: bo = bigint_export(PBO, 0)
Dim bt: bt = bigint_export(PBT, 0)
Dim pb, pt
Dim bol, btl
bol = Len(bo)
btl = Len(bt)
If bol<btl Then
intcmp = -1
ElseIf bol>btl Then
intcmp = 1
ElseIf bo = bt Then
intcmp = 0
Else
Dim i
intcmp = 0
For i=1 to bol step 8
pb = Mid(bo, i, 8)
pt = Mid(bt, i, 8)
If CSng(pb) > CSng(pt) Then
intcmp = 1
Exit For
ElseIf CSng(pb) < CSng(pt) Then
intcmp = -1
Exit For
End If
Next
End If
End Function

'把两个类相加，返回一个新的类，不带符号判断
Public Function sum_ex(BO, BT)'As BIGINT
Dim i: i = BIGINT_LENGTH
Dim carry: carry = 0
Dim B: Set B = new BIGINT
Do While i>0
B.buf(i) = BO.buf(i) + BT.buf(i) + carry
If B.buf(i)>9 Then
B.buf(i) = B.buf(i) Mod 10
carry = 1
Else
carry = 0
End If
i = i -1
Loop
Set sum_ex = B
End Function

'把两个类相减，返回新的类，不带符号判断，而且BO必须大于BT
Public Function part_ex(BO, BT)'As BIGINT
Dim i: i = BIGINT_LENGTH
Dim carry: carry = 0
Dim B: Set B = new BIGINT
Do While i>0
B.buf(i) = BO.buf(i) - BT.buf(i) - carry
If B.buf(i)<0 Then
B.buf(i) = B.buf(i) + 10
carry = 1
Else
carry = 0
End If
i = i -1
Loop
Set part_ex = B
End Function

'把两个类相加，返回新的类，带符号判断
Public Function bigint_sum(BO, BT)'As BIGINT
Dim B
If TypeName(BO)<>"BIGINT" Or TypeName(BT)<>"BIGINT" Then
Set B = bigint_import("0")
ElseIf BO.sign Then
If BT.sign Then
Set B = sum_ex(BO, BT)
B.sign = 1
Else
Select Case intcmp(BO, BT)
Case 0:
Set B = bigint_import("0")
Case 1:
Set B = part_ex(BO, BT)
B.sign = 1
Case -1:
Set B = part_ex(BT, BO)
B.sign = 0
End Select
End If
Else
If BT.sign Then
Select Case intcmp(BO, BT)
Case 0:
Set B = bigint_import("0")
Case 1:
Set B = part_ex(BO, BT)
Case -1:
Set B = part_ex(BT, BO)
B.sign = 1
End Select
Else
Set B = sum_ex(BO, BT)
End If
End If
Set bigint_sum = B
End Function

'把两个类相减，返回新的类，带符号判断
Public Function bigint_part(BO, BT)'As BIGINT
Dim B
If TypeName(BO)<>"BIGINT" Or TypeName(BT)<>"BIGINT" Then
Set B = bigint_import("0")
ElseIf BO.sign Then
If BT.sign Then
Select Case intcmp(BO, BT)
Case 0:
Set B = bigint_import("0")
Case 1:
Set B = part_ex(BO, BT)
B.sign = 1
Case -1:
Set B = part_ex(BT, BO)
B.sign = 0
End Select
Else
Set B = sum_ex(BO, BT)
B.sign = 1
End If
Else
If BT.sign Then
Set B = sum_ex(BO, BT)
Else
Select Case intcmp(BO, BT)
Case 0:
Set B = bigint_import("0")
Case 1:
Set B = part_ex(BO, BT)
Case -1:
Set B = part_ex(BT, BO)
B.sign = 1
End Select
End If
End If
Set bigint_part = B
End Function

'类左移x位
Public Function bigint_left(BO, x)'As BIGINT
Dim B: Set B = new BIGINT
Dim i: i = BIGINT_LENGTH
Do While i>0
If (i-x)<0 Then Exit Do
B.buf(i-x) = BO.buf(i)
i = i - 1
Loop
Set bigint_left = B
End Function

'BIGING类BO乘以x，并左移y位，返回新的类
Public Function multi_ex(BO, x, y)'As BIGINT
Dim i: i = BIGINT_LENGTH
Dim carry: carry = 0
Dim it
Dim B: Set B = new BIGINT
Do While i>0
B.buf(i) = BO.buf(i) * x + carry
If B.buf(i)>10 Then
it = B.buf(i)
B.buf(i) = it Mod 10
carry = it \ 10
Else
carry = 0
End If
i = i - 1
Loop
Set multi_ex = bigint_left(B, y)
End Function

'两个类相乘，返回新的类
Public Function bigint_multi(BO, BT)'As BIGINT
Dim i, k
Dim B: Set B = new BIGINT
Dim BA
Dim p: p = bigint_export(BT, 0)
i = Len(p)
k = 0
ReDim BA(i)
Do While i>0'模拟乘法递增运算
Set B = multi_ex(BO, CInt(Mid(p, i, 1)), k)
BA(k) = bigint_export(b, 0)
i = i - 1
k = k + 1
Loop
Set B = new BIGINT
For i=0 to UBound(BA)
Set B = bigint_sum(B, bigint_import(BA(i)))
Next
B.sign = IIf(BO.sign Or BT.sign, 1, 0)
Set bigint_multi = B
End Function

Dim bo: Set bo = bigint_import("99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999")
Dim bt: Set bt = bigint_import("99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999")
Dim b
Dim st, et

st = Timer
Set b = bigint_sum(bo, bt)
Debug bigint_export(b, 1)
et = Timer
Debug "加法运算，耗时" & (et - st) * 1000 & "毫秒"

st = Timer
Set b = bigint_part(bo, bt)
Debug bigint_export(b, 1)
et = Timer
Debug "减法运算，耗时" & (et - st) * 1000 & "毫秒"

st = Timer
Set b = bigint_multi(bo, bt)
Debug bigint_export(b, 1)
et = Timer
Debug "乘法运算，耗时" & (et - st) * 1000 & "毫秒"

[zhang17]

Private Function cacl(num As Long) As String
Dim numlen As Long, last As Long, x As Long
Dim i As Long, m As Long, n As Long, nl As Long, s0 As String
Dim result() As Long, starttime As Single, s() As String
numlen = 1
starttime = Timer
ReDim result(1 To numlen)
nl = 9 - Len(CStr(num)) 根据两数相乘最大得数长度，不会超过两数长度总和的原理，
让数组中每个元素长度与阶乘数长度之和不能超过9，以防止溢出。
If nl < 1 Then nl = 1 最小长度是1位，若真到了这么大的数，恐怕没人会去试了^-^
n = 10 ^ nl 缓存用于分隔大数的被除数，数组中每个元素的长度是 nl，该数就是10的 nl 次方
result(1) = 1
x = 1
Do While x <= num
last = 0
For i = 1 To numlen
m = result(i) * x last 数组中每个元素进行与待乘数相乘后，再加上上次进位数
result(i) = m Mod n 分隔大数
last = m n 保存进位数并等待累计进下一个数组元素
Next
If last > 0 Then
m = Len(CStr(last)) nl 1 对超过数组元素上限的进位数要增加数组大小，并按长度nl分隔
ReDim Preserve result(1 To numlen m)
For i = 1 To m
result(numlen i) = last Mod n
last = last n
Next
numlen = UBound(result)
End If
x = x 1
Loop
ReDim s(1 To numlen)
s0 = String(nl, 0) 对长度不足nl的数组元素要在前面补0，不然结果就在错特错了
For i = 1 To numlen
s(i) = Format(result(numlen 1 - i), s0) 格式化补 0 每个数组元素
Next
s(1) = Val(s(1))
If s(1) = 0 Then s(1) = 最高位要去掉0，虽对得数没影响，但位数会错。
cacl = Join(s, )
Debug.Print num ＆ ！ ： 用时 ; Timer - starttime ＆ 秒, 结果 ＆ Len(cacl) ＆ 位
End Function



Private Sub Command1_Click()
Dim i As Long
cacl 20000
For i = 1 To 9
cacl i * 100
Next
For i = 1 To 10
cacl i * 1000
Next
End Sub




计算结果：



100！ ： 用时 0 秒, 结果 158 位
200！ ： 用时 0 秒, 结果 375 位
300！ ： 用时 .015625 秒, 结果 615 位
400！ ： 用时 0 秒, 结果 869 位
500！ ： 用时 .015625 秒, 结果 1135 位
600！ ： 用时 .015625 秒, 结果 1409 位
700！ ： 用时 .03125 秒, 结果 1690 位
800！ ： 用时 .03125 秒, 结果 1977 位
900！ ： 用时 .0625 秒, 结果 2270 位
1000！ ： 用时 .078125 秒, 结果 2568 位
2000！ ： 用时 .3125 秒, 结果 5736 位
3000！ ： 用时 .75 秒, 结果 9131 位
4000！ ： 用时 1.390625 秒, 结果 12674 位
5000！ ： 用时 2.265625 秒, 结果 16326 位
6000！ ： 用时 3.3125 秒, 结果 20066 位
7000！ ： 用时 4.609375 秒, 结果 23878 位
8000！ ： 用时 6.125 秒, 结果 27753 位
9000！ ： 用时 7.9375 秒, 结果 31682 位
10000！ ： 用时 9.890625 秒, 结果 35660 位

[flyingsnowy]

up

[mind_1220]

楼上的这个算法 能运行吗？
我写一个我的。
<%
Dim arr()
ReDim arr(40)
index = 0
j = 1
For i = 100 To 1 step -1
j = j * i
Next
response.Write j&"<br>"
For k = 154 To 0 step -4
tmp = CInt(j / test(k)) - 1
j = j - tmp * test(k)
if len(tmp) = 5 then
tt= left(v,len(v)-1)
dd= right(v,1)
dd= dd + 1
v= tt&dd
tmp = (right(tmp,4))
end if
v = v & CStr(tmp)
Next
response.Write v
Function test(times)
Dim i
Dim v
v = 1
For i = 1 To times
v = v * 10
Next
test = v
End Function
%>
拷贝直接运行

[Newrocky]

汗
！！！

数学没学好………………

[zhang17]

不是我写的算法，是转的vb的算法，稍微改一下就可以在asp重运行

[satans18]

有意思 参与一下~~

[hjrsos]

用递归算法程序会很简洁

[mind_1220]

递归算法的效率很低

[mymyal123]

up

[yqh1314]

个人感觉 ！ 简易排序法！ 如何1````不过我写不出` 以前学过也写过，不过现在都不往哪个方向想了！

[mind_1220]

大家说的不错哈
我回去了再好好想想
还有谁有好的算法吗?

[angelyujun]

我有好的算法：
'response.write("9.33262154439442E+157") 既然不要这样显示，那就注释掉
response.write("933262154439441342545065203804399763456400347822004292163918007479219221080502693951550593085639738378274905995996983384058150646934473117340133360516676976") '要这样显示呵~~~

[da21]

这有用吗？

[opolmzy]

mark一下，吃完饭来写一个