Cod sursa(job #49679)

Utilizator floringh06Florin Ghesu floringh06 Data 6 aprilie 2007 11:11:08
Problema Patrate2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.06 kb
{$IFDEF NORMAL}
  {$I-,OBJECTCHECKS-,Q-,R-,S-}
{$ENDIF NORMAL}
{$IFDEF DEBUG}
  {$I+,OBJECTCHECKS-,Q+,R+,S-}
{$ENDIF DEBUG}
{$IFDEF RELEASE}
  {$I-,OBJECTCHECKS-,Q-,R-,S-}
{$ENDIF RELEASE}


const nmax=100;
      dmax=900;
      base=10000;

type bignum = record
      x:array[1..dmax] of longint;
      n:integer;
     end;

var n:integer;
    fi,fo:text;
    a,b,c:bignum;
    p2,fct,sol:bignum;

  procedure read_data;
   begin
    assign(fi,'patrate2.in'); reset(fi);
    readln(fi,n);
    close(fi);
   end;

  procedure write_data;
  var i,j:integer;
      s:string;
   begin
    assign(fo,'patrate2.out'); rewrite(fo);
    write(fo,sol.x[sol.n]);
    for i:=sol.n-1 downto 1 do begin
     str(sol.x[i]:4, s);
     for j:=1 to 4 do if s[j]=' ' then s[j]:='0';
     write(fo,s);
    end;
    writeln(fo);
    close(fo);
   end;

  procedure multint(var a:bignum; f:integer; c:bignum);
   var i,j,t:longint;
   begin
//    fillchar(a,sizeof(a),0);
    t:=0;
    for i:=1 to c.n do begin
     t := t + c.x[i] * f;
     a.x[i]:=t mod base;
     t:=t div base;
    end;
    if t>0 then begin
     inc(a.n);
     a.x[a.n]:=t;
    end;
   end;

  procedure multiply(var a:bignum; b,c:bignum);
   var t,i,j:longint;
   begin
//    fillchar(a,sizeof(a),0);
    for i:=1 to b.n do
     for j:=1 to c.n do
      a.x[i+j-1]:=a.x[i+j-1]+b.x[i] * c.x[j];
    t:=0;
    for i:=1 to dmax do begin
     t:=a.x[i]+t;
     a.x[i] := t mod base;
     t:=t div base;
    end;
    for i:=dmax downto 1 do
     if a.x[i] <> 0  then  begin
      a.n := i;
      break;
     end;
    if a.n=0 then a.n:=1;
   end;

  procedure work;
   var i,j:integer;
   begin
   fillchar(p2,sizeof(p2),0);
   fillchar(fct,sizeof(fct),0);
   p2.n:=1; p2.x[1]:=1;
   fct.n:=1; fct.x[1]:=1;
   for i:=1 to sqr(n) div 10 do
     multint(p2,1024,p2);
   for i:=1 to sqr(n) mod 10 do
     multint(p2,2,p2);
   for i:=1 to n do
     multint(fct,i,fct);
   multiply(sol,p2,fct);
   write_data;
   end;



begin
read_data;
work;
write_data;
end.