主题：高精度阶乘的程序出问题了
Mato完整版
[专家分：1270] 发布于 2008-05-23 23:21:00
{$N+}
TYPE
{Integer type declare}
I_ = INTEGER;
SI_ = SHORTINT;
LI_ = LONGINT;
BI_ = BYTE;
WI_ = WORD;
{Real type declare}
R_ = REAL;
SR_ = SINGLE;
DR_ = DOUBLE;
ER_ = EXTENDED;
CR_ = COMP;
{Other type declare}
C_ = CHAR;
B_ = BOOLEAN;
S_ = STRING;
FUNCTION S_TO_I(s: S_): LI_;
VAR i: LI_; k: I_;
BEGIN
VAL(s, i, k);
S_TO_I := i;
END;
FUNCTION XN(x, y: SI_): LI_;
VAR i: SI_; m: LI_;
BEGIN
m := x;
FOR i:=2 TO y DO m := m * x;
XN := m;
END;
FUNCTION I_TO_S(x: WI_): S_;
VAR s: S_;
BEGIN
STR(x, s);
I_TO_S := s;
END;
FUNCTION gjdmult(a: S_; b: LI_): S_;
VAR
l: SI_;
x: I_;
v, p: LI_;
s: S_;
BEGIN
l := 9 - LENGTH(I_TO_S(b));
IF l < 1 THEN l := 1;
p := XN(10, l);
v := 0;
s := '';
x := LENGTH(a) - l + 1;
WHILE x >= 1 DO BEGIN
v := S_TO_I(COPY(a, x, l)) * b + v;
s := COPY(I_TO_S(v), LENGTH(I_TO_S(v)) - l + 1, l) + s;
v := v DIV p;
x := x - l;
END;
IF x > 1 - l THEN v := S_TO_I(COPY(a, 1, x + l - 1)) * b + v;
IF v > 0 THEN s := I_TO_S(v) + s;
gjdmult := s;
END;
VAR
i, j, n, k: I_;
s, s0: S_;
BEGIN
READLN(n);
s := '1'; k := 0;
i := n MOD 2 + 1;
WHILE i <= n DO BEGIN
s := gjdmult(s, i * i + i);
i := i + 2;
END;
WRITELN(s);
READLN;
END.
这是我编的高精度阶乘的程序，可是只能算到8！，9！就不行了，请问各位大虾，是思路错了还是程序出了细节问题，谢谢。
[color=800000]我是新手！[/color]
回复列表 （共9个回复）
沙发
angwuy [专家分：2280] 发布于 2008-05-27 12:57:00
看得头都晕了
LZ在编pascal时不要把BASIC的习惯都带来了
用变量就直接定义，不要再重新定义多一遍，这样可读性很低
另，高精度最好用数组，用字符串不方便操作，而且很容易出错
板凳
游侠UFO [专家分：1200] 发布于 2008-05-31 02:29:00
用数组还可以一位保存多位提高效率..呵呵
PS : C++写惯了...看PASCAL越来越不习惯了....
3 楼
dlbl7129 [专家分：30] 发布于 2008-05-31 02:43:00
对吗？
100！=933262154439441526816992388562667004907159682643816214685929638952175999932299608941463976156518286253697920827223758251185210916864000000000000000000000000
200！=7886578673647905035523632139321850622951359776871732632947425332443594499634032920304284011984623904177212138919638830257642790242637105061926624952829931116285727076331723739698894392244562145166424025403329186413122742829485327752424075739032403212574055795686602260319041703240623517008587961789222227896237037374720000000000000000000000000000000000000000000000000
program test_fact;
var a0,a1,a2 : array [ 0 .. 1023 ] of word;
procedure mul;
var i0,i1,i2 : dword; d0,d1,d2 : byte; carry : boolean;
begin
for i1 := 1 to a1[0] do
begin
d1 := a1[i1]; i0 := i1;
for i2 := 1 to a2[0] do
begin
d2 := a2[i2];
d0 := d1 * d2;
a0[i0] := a0[i0] + d0 mod 10;
i0 := i0 + 1;
a0[i0] := a0[i0] + d0 div 10;
end;
if a0[i0] <> 0 then
a0[0] := i0 else a0[0] := i0 - 1;
carry := false;
for i0 := 1 to a0[0] do
begin
if carry then inc(a0[i0]);
if a0[i0] >= 10 then begin
a0[i0] := a0[i0] - 10;
carry := true;
end else carry := false;
end;
if carry then begin
a0[i0+1] := 1; a0[0] := i0+1;
end;
end;
end;
procedure ntoa1 ( n : dword );
var i1 : dword;
begin
i1 := 0;
while n > 0 do begin
i1 := i1 + 1;
a1[i1] := n mod 10;
n := n div 10;
end;
a1[0] := i1;
end;
procedure a0toa2;
var i1 : dword;
begin
for i1 := 1 to a0[0] do
a2[i1] := a0[i1];
a2[0] := a0[0];
for i1 := 0 to 1023 do
a0[i1] := 0;
end;
procedure fact ( n : dword );
var i1 : dword;
begin
for i1 := 2 to n do
begin
ntoa1(i1);
mul;
a0toa2;
if i1 = 146 then
end;
for i1 := a2[0] downto 1 do
write(a2[i1]);
writeln;
end;
begin
a2[0] := 1;
a2[1] := 1;
//fact(100);
fact(200);
readln;
end.
4 楼
Mato完整版 [专家分：1270] 发布于 2008-05-31 20:07:00
楼上的，dword类型是什么？
我用的是TP7.0，不能识别dword。
5 楼
angwuy [专家分：2280] 发布于 2008-06-01 16:12:00
Dword是32位无符号整型数据，可以在FreePascal中使用
6 楼
帅气小子 [专家分：0] 发布于 2008-07-23 12:56:00
const z=10000;
var
a:array[0..z+1]of integer;
n,j,i,k:longint;
begin
assign(input,'fac.in');
assign(output,'fac.out');
reset(input);
rewrite(output);
readln(n);
begin
a[1]:=1;
for i:=1 to n do
begin
for j:=1 to z do
a[j]:=a[j]*i;
for k:=1 to z do
begin
a[k+1]:=a[k+1]+a[k]div 10;
a[k]:=a[k]mod 10;
end;
end;
i:=z;k:=0;
repeat
if a[i]<>0 then k:=1;
i:=i-1;
until k=1;
k:=0;
for j:=i+1 downto 1 do
write(a[j]);
end;
writeln;
close(input);
close(output);
end.
这个求阶乘的程序更简便
7 楼
shiliming [专家分：0] 发布于 2009-03-21 14:24:00
program sdkj;
var a:array[1..1000]of longint;
var i,w,n:longint;
procedure aaa(k:longint);
var i,x:longint;
begin
for i:=1 to w do begin
a[i]:=a[i]*k+x;
x:=a[i] div 10;
a[i]:=a[i] mod 10;
end;
while x>0 do begin
w:=w+1;
a[w]:=x mod 10;
x:=x div 10;
end;
end;
begin
readln(n);
a[1]:=1;
w:=1;
for i:=1 to n do aaa(i);
for i:=n downto 1 do write(a[i]);
end.
8 楼
幽灵密码 [专家分：3510] 发布于 2011-07-03 11:03:00
uses crt;
var i,j,c,n:integer;
a:array[0..60000]of integer;
begin
clrscr;
readln(n);
writeln(n,'! =');
a[1]:=1;
a[0]:=1;
c:=0;
for i:=2 to n do begin
for j:=1 to a[0] do begin
a[j]:=a[j]*i+c;
c:=a[j] div 10;
a[j]:=a[j] mod 10
end;
while (c>0) do begin
inc(a[0]);
a[a[0]]:=c;
c:=c div 10;
a[a[0]]:=a[a[0]] mod 10
end
end;
for i:=a[0] downto 1 do write(a[i]);
writeln;
writeln('Length=',a[0]);
readln
end.
9 楼
idealguy [专家分：110] 发布于 2011-11-24 10:58:00
回8楼幽灵密码
原程序计算较大n时会发生a[j]*i+c 溢出（TP7.0下）
略作修改（数组改为Byte)
[font=宋体]
uses crt;
var j,n:integer;
i,c,d,Na:LongInt;
a:array[0..32000] of byte;
begin
clrscr;
write('N(1..9000)='); readln(n);
if n>9000 then n:=9000;
writeln(n,'! =');
Na:=1;
a[1]:=1;
c:=0;
for i:=2 to n do begin
for j:=1 to Na do begin
d:=a[j]*i+c;
c:=d div 10;
a[j]:=d-c*10;
end;
while (c>0) do begin
inc(Na);
a[Na]:=c mod 10;
c:=c div 10;
end
end;
for i:=Na downto 1 do write(a[i]);
writeln;
writeln('Length=',Na);
readln
end.
[/font]
我来回复
您所在位置：