Re: 1000! и вывести дело на экран?
От: Spark  
Дата: 18.02.03 10:40
Оценка:
Здравствуйте, NewMan21, Вы писали:

NM>У меня было задание сделать факториал 1000 и вывести все это безобразие в файл. А вот про алгоритм на C или Pascal'e мне что-то и не дался. Может кто подсказать как такое сотворить, а то что-то памяти на рекурсивную функцию не хватает, а разрядов в самой большой переменной — тоже. А выводить еще нужно нормальными числами (не 12+e33 или типа того)

NM>Кто может написать алгоритм? Можно в C, Pascal, PHP

Если тема еще актуальна, то вот работающий код.
Правда для расчета 1000! не хватает разрядности, но можно увеличить:
(С) "Советы по Дельфи от Валентина Озерова"

unit HugeInts;

{$DEFINE HugeInt_128}

interface

const
  {$IFDEF HugeInt_128 }
  HugeIntSize = 128;
  {$ELSE}{$IFDEF HugeInt_64 }
  HugeIntSize = 64;
  {$ELSE}{$IFDEF HugeInt_32 }
  HugeIntSize = 32;
  {$ELSE}{$IFDEF HugeInt_16 }
  HugeIntSize = 16;
  {$ELSE}
  HugeIntSize = 8;
  {$ENDIF}{$ENDIF}{$ENDIF}{$ENDIF}

  HugeIntMSB  = HugeIntSize-1;

type
  HugeInt = array[0..HugeIntMSB] of Byte;

const
  HugeIntCarry: Boolean = False;
  HugeIntDiv0:  Boolean = False;


procedure HugeInt_Min(var a: HugeInt);                 { a := -a }
procedure HugeInt_Inc(var a: HugeInt);                 { a := a + 1 }
procedure HugeInt_Dec(var a: HugeInt);                 { a := a - 1 }

procedure HugeInt_Add(a, b: HugeInt; var R: HugeInt);  { R := a + b }
procedure HugeInt_Sub(a, b: HugeInt; var R: HugeInt);  { R := a - b }
procedure HugeInt_Mul(a, b: HugeInt; var R: HugeInt);  { R := a * b }
procedure HugeInt_Div(a, b: HugeInt; var R: HugeInt);  { R := a div b }
procedure HugeInt_Mod(a, b: HugeInt; var R: HugeInt);  { R := a mod b }

function HugeInt_IsNeg(a: HugeInt): Boolean;
function HugeInt_Zero(a: HugeInt): Boolean;
function HugeInt_Odd(a: HugeInt): Boolean;

function HugeInt_Comp(a, b: HugeInt): Integer;          {-1:a< 0; 1:a>}
procedure HugeInt_Copy(Src: HugeInt; var Dest: HugeInt);{ Dest := Src }

procedure String2HugeInt(AString: string; var a: HugeInt);
procedure Integer2HugeInt(AInteger: Integer; var a: HugeInt);
procedure HugeInt2String(a: HugeInt; var S: string);

implementation
{$R+}

procedure HugeInt_Copy(Src: HugeInt; var Dest: HugeInt);
{ Dest := Src }
begin
Move(Src, Dest, SizeOf(HugeInt));
end;{ HugeInt_Copy }

function HugeInt_IsNeg(a: HugeInt): Boolean;
begin

HugeInt_IsNeg := a[HugeIntMSB] and $80 > 0;
end;{ HugeInt_IsNeg }

function HugeInt_Zero(a: HugeInt): Boolean;
var i: Integer;
begin

HugeInt_Zero := False;
for i := 0 to HugeIntMSB do
if a[i] <> 0 then Exit;
HugeInt_Zero := True;
end;{ HugeInt_Zero }

function HugeInt_Odd(a: HugeInt): Boolean;
begin

HugeInt_Odd := a[0] and 1 > 0;
end;{ HugeInt_Odd }

function HugeInt_HCD(a: HugeInt): Integer;
var i: Integer;
begin

i := HugeIntMSB;
while (i > 0) and (a[i] = 0) do Dec(i);
HugeInt_HCD := i;
end;{ HugeInt_HCD }

procedure HugeInt_SHL(var a: HugeInt; Digits: Integer);
begin
if Digits > HugeIntMSB then
FillChar(a, SizeOf(HugeInt), 0)
else if Digits > 0 then
begin
Move(a[0], a[Digits], HugeIntSize-Digits);
FillChar(a[0], Digits, 0);
end;{ else if }
end;{ HugeInt_SHL }

procedure HugeInt_SHR(var a: HugeInt; Digits: Integer);
begin
if Digits > HugeIntMSB then
FillChar(a, SizeOf(HugeInt), 0)
else if Digits > 0 then
begin
Move(a[Digits], a[0], HugeIntSize-Digits);
FillChar(a[HugeIntSize-Digits], Digits, 0);
end;{ else if }
end;{ HugeInt_SHR }

procedure HugeInt_Inc(var a: HugeInt);
{ a := a + 1 }
var

i: Integer;
h: Word;
begin

i := 0; h := 1;
repeat
h := h + a[i];
a[i] := Lo(h);
h := Hi(h);
Inc(i);
until (i > HugeIntMSB) or (h = 0);
HugeIntCarry := h > 0;
{$IFOPT R+ }
if HugeIntCarry then RunError(215);
{$ENDIF}
end;{ HugeInt_Inc }

procedure HugeInt_Dec(var a: HugeInt);
{ a := a - 1 }
var Minus_1: HugeInt;
begin

{ naiue i?inoie niinia }
FillChar(Minus_1, SizeOf(HugeInt), $FF); { -1 }
HugeInt_Add(a, Minus_1, a);
end;{ HugeInt_Dec }

procedure HugeInt_Min(var a: HugeInt);
{ a := -a }
var i: Integer;
begin

for i := 0 to HugeIntMSB do
a[i] := not a[i];
HugeInt_Inc(a);
end;{ HugeInt_Min }

function HugeInt_Comp(a, b: HugeInt): Integer;
{ a = b: ==0; a > b: ==1; a < b: ==-1 }
var

A_IsNeg, B_IsNeg: Boolean;
i:                Integer;
begin

A_IsNeg := HugeInt_IsNeg(a);
B_IsNeg := HugeInt_IsNeg(b);
if A_IsNeg xor B_IsNeg then
if A_IsNeg then HugeInt_Comp := -1
else HugeInt_Comp := 1
else
begin
if A_IsNeg then HugeInt_Min(a);
if B_IsNeg then HugeInt_Min(b);
i := HugeIntMSB;
while (i > 0) and (a[i] = b[i]) do Dec(i);
if A_IsNeg then { iaa io?eoaoaeuiua! }
if a[i] > b[i] then HugeInt_Comp := -1
else if a[i] < b[i] then HugeInt_Comp := 1
else HugeInt_Comp := 0
else { iaa iiei?eoaeuiua }
if a[i] > b[i] then HugeInt_Comp := 1
else if a[i] < b[i] then HugeInt_Comp := -1
else HugeInt_Comp := 0;
end;{ else }
end;{ HugeInt_Comp }

procedure HugeInt_Add(a, b: HugeInt; var R: HugeInt);
{ R := a + b }
var

i: Integer;
h: Word;
begin

h := 0;
for i := 0 to HugeIntMSB do
begin
h := h + a[i] + b[i];
R[i] := Lo(h);
h := Hi(h);
end;{ for }
HugeIntCarry := h > 0;
{$IFOPT R+ }
if HugeIntCarry then RunError(215);
{$ENDIF}
end;{ HugeInt_Add }

procedure HugeInt_Sub(a, b: HugeInt; var R: HugeInt);
{ R := a - b }
begin
HugeInt_Min(b);
HugeInt_Add(a, b, R);
end;{ HugeInt_Sub }

procedure HugeInt_Mul(a, b: HugeInt; var R: HugeInt);
{ R := a * b }
var

i, j, k:          Integer;
A_end, B_end:     Integer;
A_IsNeg, B_IsNeg: Boolean;
h:                Word;
begin

A_IsNeg := HugeInt_IsNeg(a);
B_IsNeg := HugeInt_IsNeg(b);
if A_IsNeg then HugeInt_Min(a);
if B_IsNeg then HugeInt_Min(b);
A_End := HugeInt_HCD(a);
B_End := HugeInt_HCD(b);
FillChar(R, SizeOf(R), 0);
HugeIntCarry := False;
for i := 0 to A_end do
begin
h := 0;
for j:= 0 to B_end do
if (i + j) < HugeIntSize then
begin
h := h + R[i+j] + a[i] * b[j];
R[i+j] := Lo(h);
h := Hi(h);
end;{ if }
k := i + B_End + 1;
while (k < HugeIntSize) and (h > 0) do
begin
h := h + R[k];
R[k] := Lo(h);
h := Hi(h);
Inc(k);
end;{ while }
HugeIntCarry := h > 0;
{$IFOPT R+}
if HugeIntCarry then RunError(215);
{$ENDIF}
end;{ for }
{ anee ana oi?ioi... }
if A_IsNeg xor B_IsNeg then HugeInt_Min(R);
end;{ HugeInt_Mul }

procedure HugeInt_DivMod(var a: HugeInt; b: HugeInt; var R: HugeInt);
{ R := a div b  a := a mod b }
var

MaxShifts, s, q:  Integer;
d, e:             HugeInt;
A_IsNeg, B_IsNeg: Boolean;
begin

if HugeInt_Zero(b) then
begin
HugeIntDiv0 := True;
Exit;
end{ if }
else HugeIntDiv0 := False;
A_IsNeg := HugeInt_IsNeg(a);
B_IsNeg := HugeInt_IsNeg(b);
if A_IsNeg then HugeInt_Min(a);
if B_IsNeg then HugeInt_Min(b);
if HugeInt_Comp(a, b) < 0 then

FillChar(R, SizeOf(R), 0)
else
begin
FillChar(R, SizeOf(R), 0);
repeat
Move(b, d, SizeOf(HugeInt));

MaxShifts := HugeInt_HCD(a) - HugeInt_HCD(b);
s := 0;
while (s <= MaxShifts) and (HugeInt_Comp(a, d) >= 0) do
begin
Inc(s);
HugeInt_SHL(d, 1);
end;{ while }
Dec(s);
{ Nicaaai iiao? eiie? b }
Move(b, d, SizeOf(HugeInt));
{ Ia?aiauaai (naaeaaai) d }
HugeInt_ShL(d, S);

Move(d, e, SizeOf(HugeInt));
HugeInt_Min(e);
Q := 0;
{ iiea a >= d au?eneyai a := a+-d e i?e?aueaaai Q}
while HugeInt_Comp(a, d) >= 0 do
begin
HugeInt_Add(a, e, a);
Inc(Q);
end;{ while }

if HugeInt_IsNeg(a) then
begin
HugeInt_Add(a, d, a);
Dec(Q);
end;{ if }
HugeInt_SHL(R, 1);
R[0] := Q;
until HugeInt_Comp(a, b) < 0;
if A_IsNeg xor B_IsNeg then HugeInt_Min(R);
end;{ else }
end;{ HugeInt_Div }

procedure HugeInt_DivMod100(var a: HugeInt; var R: Integer);
var
Q: HugeInt;
S: Integer;
begin

R := 0; FillChar(Q, SizeOf(Q), 0);
S := HugeInt_HCD(a);
repeat
r := 256*R + a[S];
HugeInt_SHL(Q, 1);
Q[0] := R div 100;
R := R mod 100;
Dec(S);
until S < 0;
Move(Q, a, SizeOf(Q));
end;{ HugeInt_DivMod100 }

procedure HugeInt_Div(a, b: HugeInt; var R: HugeInt);
begin

HugeInt_DivMod(a, b, R);
end;{ HugeInt_Div }

procedure HugeInt_Mod(a, b: HugeInt; var R: HugeInt);
begin

HugeInt_DivMod(a, b, R);
Move(a, R, SizeOf(HugeInt));
end;{ HugeInt_Mod }

procedure HugeInt2String(a: HugeInt; var S: string);

function Str100(i: Integer): string;
begin
Str100 := Chr(i div 10 + Ord('0')) + Chr(i mod 10 + Ord('0'));
end;{ Str100 }
var

R:      Integer;
Is_Neg: Boolean;
begin

S := '';
Is_Neg := HugeInt_IsNeg(a);
if Is_Neg then HugeInt_Min(a);
repeat
HugeInt_DivMod100(a, R);
Insert(Str100(R), S, 1);
until HugeInt_Zero(a) or (Length(S) = 254);
while (Length(S) > 1) and (S[1] = '0') do Delete(S, 1, 1);
if Is_Neg then Insert('-', S, 1);
end;{ HugeInt2String }

procedure String_DivMod256(var S: string; var R: Integer);
var Q: string;
begin

FillChar(Q, SizeOf(Q), 0);
R := 0;
while S <> '' do
begin
R := 10*R + Ord(S[1]) - Ord('0'); Delete(S, 1, 1);
Q := Q + Chr(R div 256 + Ord('0'));
R := R  mod 256;
end;{ while }
while (Q <> '') and (Q[1] = '0') do Delete(Q, 1, 1);
S := Q;
end;{ String_DivMod256 }

procedure String2HugeInt(AString: string; var a: HugeInt);
var

i, h:   Integer;
Is_Neg: Boolean;
begin

if AString = '' then AString := '0';
Is_Neg := AString[1] = '-';
if Is_Neg then Delete(Astring, 1, 1);
i := 0;
while (AString <> '') and (i <= HugeIntMSB) do
begin
String_DivMod256(AString, h);
a[i] := h;
Inc(i);
end;{ while }
if Is_Neg then HugeInt_Min(a);
end;{ String2HugeInt }

procedure Integer2HugeInt(AInteger: Integer; var a: HugeInt);
var Is_Neg: Boolean;
begin

Is_Neg := AInteger < 0;
if Is_Neg then AInteger := -AInteger;
FillChar(a, SizeOf(HugeInt), 0);
Move(AInteger, a, SizeOf(Integer));
if Is_Neg then HugeInt_Min(a);
end;{ Integer2HugeInt }

end.
... << RSDN@Home 1.0 beta 6a >>
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.