Cod sursa(job #37121)

Utilizator floringh06Florin Ghesu floringh06 Data 24 martie 2007 17:11:17
Problema Patrate2 Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.5 kb
type number = array[0..3500] of word;

var fi,fo:text;
    a,rez,fact,p2:number;
    pw,i,n:longint;

  procedure invers;
   var i,aux:integer;
    begin
     for i:=1 to (rez[0]) div 2 do
      begin  aux:=rez[i]; rez[i]:=rez[rez[0]-i+1]; rez[rez[0]-i+1]:=aux; end;
    end;

  procedure produs(var rez:number; x:integer);
   var i,t:integer;
   begin
   t:=0; i:=1;
   while (i<=rez[0]) or (t<>0) do
    begin t:=t div 10; t:=t+rez[i]*x; rez[i]:=t mod 10; inc(i); end;
    rez[0]:=i-1;
   if (rez[rez[0]] = 0) and (rez[rez[0]+1]=0) then dec(rez[0]);
   end;


  procedure work;
   var i:integer;
    begin
    rez[0]:=a[0]+p2[0]-1;
     for i:=1 to a[0]+p2[0]-2 do
      if rez[i] div 10>=0 then
       begin
        rez[i+1]:=rez[i+1]+rez[i] div 10; rez[i]:=rez[i] mod 10;
       end;   invers;
    end;

  procedure produs1(var a,p2,rez:number);
   var i,j,k:integer;
    begin
     k:=0;
     fillchar(rez,sizeof(rez),0);
     for j:=p2[0] downto 1 do
     begin
      for i:=a[0] downto 1 do
       rez[a[0]-i+k+1]:=rez[a[0]-i+k+1]+p2[j]*a[i];
      inc(k);
     end; work;
    end;


begin
 assign(fi,'patrate2.in'); reset(fi);
 assign(fo,'patrate2.out'); rewrite(fo);
 readln(fi,n);
 pw:=n*n;
 rez[1]:=1; rez[0]:=1;
 for i:=1 to pw do
  produs(rez,2);
 invers;
 p2:=rez;
 fillchar(rez,sizeof(rez),0);
 rez[0]:=1; rez[1]:=1;
 for i:=1 to n do
  produs(rez,i);
 invers;
 a:=rez;
 produs1(a,p2,rez);
 for i:=1 to rez[0] do
  write(fo,rez[i]);
close(fo);
end.