Cod sursa(job #46114)

Utilizator andrewgPestele cel Mare andrewg Data 2 aprilie 2007 12:48:19
Problema Indep Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.55 kb
const maxn = 501;
      maxv = 1001;
      maxlen = 100;
      baza = 10000;

type huge = array[0..maxlen]of integer;

var f:text;
    n,i,j,max:longint;
    unu:huge;
    c,d:array[1..maxv]of huge;
    a:array[1..maxn]of longint;

procedure readdata;
begin
   assign(f,'indep.in');
   reset(f);
   readln(f,n);
   for i:=1 to n do readln(f,a[i]);
   close(f);
end;

function cmmdc(a,b:integer):integer;
var c:integer;
begin
   repeat
      while b<>0 do
      begin
         c:=a;
         a:=b;
         b:=c mod b;
      end;
   until b=0;
   cmmdc:=a;
end;

procedure add(var a,b:huge);
var v,r:longint;
begin
   v:=a[0];
   if b[0]>v then v:=b[0];
   r:=0;
   a[0]:=v;
   for i:=1 to v do
   begin
      a[i]:=a[i]+b[i]+r;
      r:=a[i] div baza;
      a[i]:=a[i] mod baza;
   end;
   if r<>0 then
   begin
      inc(a[0]);
      a[a[0]]:=r;
   end;
end;

procedure solve;
var i:longint;
begin
   max:=a[1];
   unu[0]:=1;
   unu[1]:=1;
   d[a[1]]:=unu;
   for i:=2 to n do
   begin
      for j:=1 to max do
      begin
         c[j]:=d[j];
         add(c[cmmdc(j,a[i])],d[j]);
      end;
      add(c[a[i]],unu);
      if a[i]>max then max:=a[i];
      d:=c;
   end;
end;

procedure writedata;
var s:string;
begin
   assign(f,'indep.out');
   rewrite(f);
   write(f,c[1,c[1,0]]);
   for i:=c[1,0]-1 downto 1 do
   begin
      str(c[1,i],s);
      while length(s)<4 do s:='0'+s;
      write(f,s);
   end;
   writeln(f);
   close(f);
end;

begin
   readdata;
   solve;
   writedata;
end.