Cod sursa(job #468476)

Utilizator lianaliana tucar liana Data 3 iulie 2010 20:48:12
Problema Patrate2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.76 kb
program patrate2;
type numar=array[0..3200] of int64;
var f, g:text;
    c, vg, rez:numar;
    i, j, ii:longint;
    t, n, k:int64;

function prod(a,b:numar):numar;
var z:int64;
  begin
    c:=vg;
    for i:=1 to a[0] do
      for j:=1 to b[0] do
        c[i+j-1]:=c[i+j-1]+a[i]*b[j];
    t:=0;
    c[0]:=a[0]+b[0]-1;
    for i:=1 to c[0] do
      begin
        z:=c[i]+t;
        c[i]:=z mod 10;
        t:=z div 10;
      end;
    while t>0 do
      begin
        c[0]:=c[0]+1;
        c[c[0]]:=t mod 10;
        t:=t div 10;
      end;
    prod:=c;
  end;

function prod_nr(a:numar;z:longint):numar;
  begin
    c:=vg;
    t:=0;
    for i:=1 to a[0] do
      begin
        k:=a[i]*z+t;
        c[i]:=k mod 10;
        t:=k div 10;
      end;
    c[0]:=a[0];
    while t>0 do
      begin
        c[0]:=c[0]+1;
        c[c[0]]:=t mod 10;
        t:=t div 10;
      end;
    prod_nr:=c;
  end;

{function putere(k:longint):numar;
var x:numar;
  begin
    if k=0 then
      begin
       putere[0]:=1;
       putere[1]:=1;
      end
     else
       if k mod 2=0 then
         begin
           x:=putere(k div 2);
           putere:=prod(x,x);
         end
        else
          begin
            x:=putere(k div 2);
            putere:=prod_nr(prod(x,x),2);
          end;
  end;
}
  begin
    assign(f,'patrate2.in'); reset(f);
    assign(g,'patrate2.out'); rewrite(g);
    readln(f,n);
    rez[0]:=1;
    rez[1]:=1;
    for ii:=1 to n do
      rez:=prod_nr(rez,ii);
    n:=n*n;
    while n>30 do
      begin
        rez:=prod_nr(rez,1 shl 30);
        n:=n-30;
      end;
    rez:=prod_nr(rez,1 shl n);
    for i:=rez[0] downto 1 do
      write(g,rez[i]);
    writeln(g);
    close(f);
    close(g);
  end.