Cod sursa(job #688910)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 23 februarie 2012 22:44:23
Problema Patrate2 Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 1 kb
var v:array [1..3500] of shortint;
    n, l, r, rs, m, p2:int64;
    i, j:longint;
    p:int64;
    f, g:text;
    buf2:array [1.. 1 shl 17] of char;

begin
assign (f, 'patrate2.in'); reset (f);
assign (g, 'patrate2.out'); settextbuf (g, buf2); rewrite (g);

read (f, n);
v[1]:=1; l:=1;

for i := 2 to n do
  begin
  r:=0;
  for j := 1 to l do
    begin
    rs:=(v[j]*i+r) div 10;
    v[j]:=(v[j]*i+r) mod 10;
    r:=rs;
    end;
  while r<> 0 do
    begin
    inc (j);
    v[j]:=r mod 10;
    r:=r div 10;
    end;
  l:=j;
  end;

p:=1; p2:=60;
//for i := 1 to 60 do p := p*2;
p:=1 shl 60;
m:=n*n;
while m>0 do
  begin
  r:=0;
  while p2>m do begin dec (p2); p:=p div 2; end;

  for j := 1 to l do
    begin
    rs:=(v[j]*p +r) div 10;
    v[j]:=(v[j]*p+r) mod 10;
    r:=rs;
    end;
  while r <> 0 do
    begin
    inc (j);
    v[j]:=r mod 10;
    r:=r div 10;
    end;
  l:=j;
  m:=m-p2;
  end;

for i := l downto 1 do write (g, v[i]);
close (f); close (g);
end.