
Реализация должна вроде с помощью записи чисел в массив
Но до меня чо то не доходит как это сделать
uses crt;
const
_maxdig=1000;
_osn=10000;
type
Tlong=array[0.._maxdig]of integer;
Plong=^Tlong;
procedure WriteLong(var f:text;a:Plong);
var
ls, s: string;
i: integer;
begin
str(_osn div 10,ls);
write(f,a^[a^[0]]);
for i:=a^[0]-1 downto 1 do begin
str(a^[i],s);
while length(s)<length(ls) do s:='0'+s;
write(f,s);
end;
writeln(f);
end;
procedure MulLongShort(a:Plong;const k:longint;c:Plong);
var i: integer;
begin
fillchar(c^,sizeof(c^),0);
if k=0 then inc(c^[0]) else begin
for i:=1 to a^[0] do begin
c^[i+1]:=(longint(a^[i])*k+c^[i]) div _osn;
c^[i]:=(longint(a^[i])*k+c^[i]) mod _osn;
end;
if c^[a^[0]+1]>0 then c^[0]:=a^[0]+1 else c^[0]:=a^[0];
end;
end;
var
long_n1, long_n2: PLong;
i: integer;
console: text;
begin
long_n1 := new(plong);
long_n2 := new(plong);
long_n1^[0] := 1; long_n1^[1] := 1; { <-- long_n1 := 1 }
for i := 1 to 500 do begin
mullongshort(long_n1, 2, long_n2);
long_n1^ := long_n2^;
end;
assigncrt(console); rewrite(console);
writelong(console, long_n1);
close(console);
end.
uses crt;
const
_maxdig=1000;
_osn=10000;
type
Tlong=array[0.._maxdig]of integer;
Plong=^Tlong;
procedure WriteLong(var f:text;a:Plong);
var
ls, s: string;
i: integer;
begin
str(_osn div 10,ls);
write(f,a^[a^[0]]);
for i:=a^[0]-1 downto 1 do begin
str(a^[i],s);
while length(s)<length(ls) do s:='0'+s;
write(f,s);
end;
writeln(f);
end;
procedure MulLongShort(a:Plong;const k:longint;c:Plong);
var i: integer;
begin
fillchar(c^,sizeof(c^),0);
if k=0 then inc(c^[0]) else begin
for i:=1 to a^[0] do begin
c^[i+1]:=(longint(a^[i])*k+c^[i]) div _osn;
c^[i]:=(longint(a^[i])*k+c^[i]) mod _osn;
end;
if c^[a^[0]+1]>0 then c^[0]:=a^[0]+1 else c^[0]:=a^[0];
end;
end;
var
long_n1, long_n2: PLong;
i: integer;
console: text;
begin
long_n1 := new(plong);
long_n2 := new(plong);
long_n1^[0] := 1; long_n1^[1] := 1; { <-- long_n1 := 1 }
for i := 1 to 500 do begin
mullongshort(long_n1, 2, long_n2);
long_n1^ := long_n2^;
end;
assigncrt(console); rewrite(console);
writelong(console, long_n1);
close(console);
end.
buffer^ := first^;
for i := 1 to pred(99) do begin { <--- Здесь !!! }
mullongtwo(first, buffer, T);
first^ := T^;
end;
buffer^ := first^;
for i := 1 to pred(99) do begin { <--- Здесь !!! }
mullongtwo(first, buffer, T);
first^ := T^;
end;
uses crt;
const
_maxdig=10000;
_osn=10000;
type
Tlong=array[0.._maxdig]of integer;
Plong=^Tlong;
procedure ReadLong(var f:text;a:Plong);
var ch:char;
i:integer;
begin
fillchar(a^,sizeof(a^),0);
read(f,ch);
while not (ch in ['0'..'9',#26]) do read(f,ch);
while ch in ['0'..'9'] do
begin
for i:=a^[0] downto 1 do
begin
a^[i+1]:=a^[i+1]+(longint(a^[i])*10)div _osn;
a^[i]:=(longint(a^[i])*10)mod _osn;
end;
a^[1]:=a^[1]+ord(ch)-ord('0');
if a^[a^[0]+1]>0 then inc(a^[0]);
read(f,ch);
end;
end;
procedure WriteLong(var f:text;a:Plong);
var
ls, s: string;
i: integer;
begin
str(_osn div 10,ls);
write(f,a^[a^[0]]);
for i:=a^[0]-1 downto 1 do begin
str(a^[i],s);
while length(s)<length(ls) do s:='0'+s;
write(f,s);
end;
writeln(f);
end;
procedure MulLongTwo(a,b,c:Plong);
var i,j:integer;
dv:longint;
begin
fillchar(c^,sizeof(c^),0);
for i:=1 to a^[0] do
for j:=1 to b^[0] do
begin
dv:=longint(a^[i])*b^[j]+c^[i+j-1];
c^[i+j]:=c^[i+j]+dv div _osn;
c^[i+j-1]:=dv mod _osn;
end;
c^[0]:=a^[0]+b^[0];
while (c^[0]>1) and (c^[c^[0]]=0) do dec(c^[0]);
end;
var
first, second, T, buffer: PLong;
i: integer;
console: text;
begin
first := new(plong);
second := new(plong);
t := new(plong);
buffer := new(plong);
assigncrt(console); reset(console);
write('-> 2017 '); readlong(console, first);
close(console);
buffer^ := first^;
for i := 2 to 2017 do begin
mullongtwo(first, buffer, T);
first^ := T^;
end;
assign(console, 'long.txt'); rewrite(console);
writeln(console, '2017 ^ 2017 = ');
writelong(console, first);
close(console);
end.