program FibonacciAndFactorial;
uses
SysUtils,DateUtils; { only for the timer }
Function Fibonacci(n :longint): ansistring; {standalone}
var
n_,x:longint;
addup,addcarry,diff,LL:longint;
sl,l,term:ansistring;
slp,lp,termp:pchar;
label
skip;
Type
TA = Array[0..19] of longint;
var
addqmod,addbool:TA;
begin // set look up arrays
term:='';
for x:=0 to 9 do
begin
Addqmod[x]:=x+48;
addqmod[x+10]:=x+48;
addbool[x]:=0;
addbool[x+10]:=1;
end;
{first few terms according to Wiki}
if (n=1) then
begin
fibonacci:='0';
exit;
end;
if (n=2) or (n=3) then
begin
fibonacci:='1';
exit;
end;
if (n=4) then
fibonacci:= '2'
else
begin
sl:='1';
l:='2' ;
For x := 1 To n-4 do
begin
LL:=Length(l);
diff:=0;
if LL <> length(sl) then diff:=1 ;
addcarry:=0;
term:='0'+l ;
slp:=@sl[1]; // set pointers //
lp:=@l[1];
termp:=@term[1];
For n_ :=LL-1 downTo diff do
begin
addup:=ord(slp[n_-diff])+ord(lp[n_])-96 ;
ord(termp[n_+1]):=ADDQmod[addup+addcarry] ;
addcarry:=ADDbool[addup+addcarry];
end; {next n_}
If addcarry=0 Then
begin
if termp[0]='0' then term:=copy(term,2,length(term)-1) ;
goto skip;
end;
If n_= 0 Then
begin
ord(termp[0]):=addcarry+48 ;
goto skip;
end;
addup:=ord(lp[0])-48;
ord(termp[1]):=ADDQmod[addup+addcarry];
addcarry:=ADDbool[addup+addcarry];
ord(termp[0]):=addcarry+48 ;
if (addcarry=0) then
begin
if termp[0]='0' then term:=copy(term,2,length(term)-1)
end;
skip:
sl:=l ;
l:=term;
end; {next x}
fibonacci:=term;
end; {end if else}
end; {function fibonacci}
function factorial(num:longint):ansistring ; {standalone}
type
AT = array[0..99] of longint;
var
_mod,_div:at;
fact,a,b,c:ansistring;
pa,pb,pc:pchar;
n,carry,ai:smallint;
la,lb,i,j,z:longint;
begin {create lookup tables}
for z:=0 to 99 do
begin
_mod[z]:= (z mod 10) +48;
_div[z]:= z div 10;
end; {created lookup tables}
fact:='1';
for z:=1 to num do
begin
a:=fact;Str(z,b);la:=Length(a);lb:=length(b);
Setlength(c,la+lb);
FillChar(c[1],la+lb,#48);
pa:=@a[1]; {set pointers }
pb:=@b[1];
pc:=@c[1];
for i:=la-1 downto 0 do
begin
carry:=0;ai:=ord(pa[i])-48 ;
for j:= lb-1 downto 0 do
begin
n :=ai*(ord(pb[j])-48)+(ord(pc[i+j+1])-48)+carry;
carry :=_Div[n];ord(pc[i+j+1]):=_Mod[n];
end; {next j}
ord(pc[i]):=ord(pc[i])+carry ;
end; {next i}
fact:=c;
if c[1]='0' then fact:=copy(c,2,length(c)-1) ;
end;{next z}
factorial:=fact;
end; {function factorial}
// ======== test functions fibonacci and factorial ========= //
var
D1,D2: TDateTime;
ans:ansistring;
num:longint;
z:integer;
begin
{=================== Test Fibonacci ============}
num:=50000;
writeln('Hang on... creating fibonacc1 ',num);
d1:=Now ;
ans:= Fibonacci(num);
d2:=Now;
writeln(ans);
Writeln( MilliSecondsBetween(D1, D2), ' milliseconds');
writeln('Press enter to continue...');
readln;
for z:=1 to 200 do
begin
writeln('fib ',z,' ',fibonacci(z));
end;
writeln('Press enter to continue...');
readln;
{=================== Test factorial ============}
num:= 5000;
writeln('factotial ',num,' = ');
D1:=now;
ans:= factorial(num);
D2:=now;
writeln(ans);
writeln( MilliSecondsBetween(D1, D2), ' milliseconds');
writeln('Done, press enter to end');
readln;
end.