Расширение longint'a

[GOfffer]

_http://ifolder.ru/5058913_
Тут лежат плоды моего труда, не совсем моего в файле факториал, но собственно помогите плз расширить лонгинт, как в файле факториал...
Нужно, чтобы программа автоморфных чисел выводила больше чисел (с лонгинтом их всего 8...)

[Хыиуду]

А слабо текст сюда? И задание более понятно?

[GOfffer]

А слабо текст сюда? И задание более понятно?

нет, задали сделать программу для вывода последовательности автоморфных чисел , я сделал программу:

Program automorph;
uses crt;
Var
N,Tek_Kol:longint;
i:longint;
Function Automorph(X:longint):Boolean;
Var
Y:longint;
S1,S2,S3:String;
Begin
Y:=X*X;
Str(X,S1);
Str(Y,S2);
S3:=Copy(S2,Length(S2)-Length(S1)+1,Length(S1));
If S1=S3 Then Automorph:=True Else Automorph:=False;
End;
Begin
Write('VVEDITE KOLICHESTVO AVTOAMORFNUH CHISEL(max=8): ');
ReadLn(N);
if N>8 then exit;
writeln(' OKaY :-)))...');
Tek_Kol:=0;
i:=1;
While Tek_Kol<>N Do
Begin
If Automorph(i) Then
Begin
WriteLn(i,' <---> ', sqr(i));
Tek_Kol:=Tek_Kol+1;
End;
i:=i+1;
End;
readln;
clrscr;
End.

Но у нее недостатк в том, что она может вывести только первые 8 чисел, а нужно побольше...
Есть программа для вычисления факториала, там макс длина выводимого 303 символа (у лонгинта вроде 20)
сабж

program factorial;
label 1;
var x:array[0..100] of longint;
y,n,L,i,w,a,k:longint;
q,s:string;
begin
write('n=?');readln(n);
L:=0; x[0]:=1;
if n<2 then goto 1;
for i:=2 to 100 do x:=0;
for y:=2 to n do begin
w:=0;
for i:=0 to L do begin
a:=x*y+w;
w:=a div 1000;
x:=a-w*1000;
end;
if w<>0 then begin L:=L+1; x[L]:=w; end;
end;
1:writeln(n,'!=');
k:=0;
for i:=L downto 0 do begin
str(x,s);
q:='0';
if i=L then q:=' ';
if x<100 then s:=q+s;
if x<10 then s:=q+s;
s:=' '+s;
write(s);
k:=k+1;
if k=20 then begin writeln; k:=0; end;
end;
writeln;
end.

Я очень туго думаю, но не понимаю как выдрать из этой проги исчисление в 1000 системе исчисления....
Короче нужно выдрать кусок кода из проги 2 и приклеить к проге один, чтобы прога один выводила больше чисел!
ps Теперь понятно?

[airyashov]

Код: Выделить всё

for y:=2 to n do begin
w:=0;
for i:=0 to L do begin
a:=x[i]*y+w;
w:=a div 1000;
x[i]:=a-w*1000; 
end;
if w<>0 then begin L:=L+1; x[L]:=w; end;
end;

вот кусок с пересчетом, чего тут не понятного?

только над сравнением подумать надо

[GOfffer]

а как мне в прогу это вставить?

[airyashov]

а как мне в прогу это вставить?

Думаю это никак не втавишь вообще-то и не надо надо считать вам только последние две (три, четыре) цифры при возведении в квадрат, т.е. надо подумать над алгоритмом,
причем должны быть равны цифры - последняя цифра произведения, последних цифр числа и последняя цифра числа, т.е. не надо перебирать все числа, а только те которые оканчиваются 0, 1, 5, 6 (причем 0, 1 это чистный случай можно не рассматривать)

советую для начала перемножить цифры столбиком и подумать

[Хыиуду]

Проще говоря, когда мы проверяем, скажем, число 25, мы раскладываем его квадрат как 20*20+20*5+5*20+5*5. При этом слагаемое 20*20 можно однозначно вычеркнуть, поскольку оно априори больше 100 и заканчивается на два нуля.

[BHy4ok]

Значение в этой строке не пробывал менять ?

Код: Выделить всё

if N>8 then exit;

[somewhere]

Вот, даю наводку, здесь я написал все нужные функции, кроме одной - нахождение самих чисел, которую писать 5-10 мин. Оставляю это вам. Обратите внимание на способ возведения в квадрат, а также на дельный совет airyashov. Поле Size содержит кол-во разрядов в числе, Digs содержит цифры числа начиная с самого младшего разряда. Поддерживаемый размер чисел до 10^256. На первое время, я думаю хватит. Если есть вопросы, задавайте.

Код: Выделить всё

uses crt;

type
BigNumber = record size:byte;
                   digs:Array[0..255] of byte;
            end;

var
B     : BigNumber;

Procedure LoadBN(var A:BigNumber; I:LongInt);
var x, t:Byte;
begin
FillChar(a.Digs[0], 256, 0);
x := 0;
repeat
  a.Digs[x] := I mod 10;
  I := I div 10;
  inc(x);
until I = 0;
a.Size := x;
end;

Procedure WriteBN(var I:BigNumber);
var x: Integer;
begin
for x := I.Size-1 downto 0 do Write(I.Digs[x]);
end;

Procedure SqrBN(var I:BigNumber);
var B     : BigNumber;
    x, y  : Integer;
begin
B := I;
LoadBN(I, 0);
For y := 0 to B.Size-1 do
  For x := 0 to B.Size-1 do
    Inc(I.Digs[x+y], B.Digs[x] * B.Digs[y]);
for x := 0 to 254 do
  begin
  Inc(I.Digs[x+1], I.Digs[x] div 10);
  I.Digs[x] := I.Digs[x] mod 10;
  end;
I.Size := 255;
While I.Digs[I.Size] = 0 do dec(I.Size);
inc(I.Size);
end;

begin
ClrScr;
LoadBN(B, 625);
WriteBN(B); Writeln;
SqrBN(B);
WriteBN(B);
end.

[GOfffer]

Значение в этой строке не пробывал менять ?

Код: Выделить всё

if N>8 then exit;

это написал я, так как если этого не будет, то будет неправильное число...