Cod sursa(job #58010)

Utilizator gurneySachelarie Bogdan gurney Data 3 mai 2007 21:38:23
Problema Indep Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.58 kb
program indep;
  const
    fin='indep.in';
    fout='indep.out';
    nmax=500;
    base=10;
type huge=array[0..1000] of longint;
var f:text;
    v,u,w,c,r:huge;
    i,j,k:integer;
    n,rest:longint;
    ch:char;
    a:array[1..nmax] of integer;
    nr:array[0..1,0..1000] of huge;
    unu:huge;
    old,new:integer;

function cmmdc(x,y:longint):longint;
  var
    r:longint;
  begin
    if x=0 then
      cmmdc:=y
    else
      if y=0 then
        cmmdc:=x
    else
    begin
      repeat
        r:=x mod y;
        x:=y;y:=r;
        until r=0;
        cmmdc:=x;
      end;
  end;

procedure citeste(var x:huge);
var i:integer;
begin
{citeste un numar mare din fisier si il depune in x}
  x[0]:=0;
  while not seekeoln(f) do begin
    inc(x[0]);read(f,ch);
    x[x[0]]:=ord(ch)-48;
  end;
  for i:=1 to x[0] div 2 do
  begin
    x[i]:=x[i] xor x[x[0]-i+1];
    x[x[0]-i+1]:=x[i] xor x[x[0]-i+1];
    x[i]:=x[i] xor x[x[0]-i+1];
  end;
  readln(f);
end;

procedure scrie(x:huge);
var i:integer;
begin
{scrie in fisier numarul mare retinut in x}
  if x[0]=0 then write(f,'0') else
  for i:=x[0] downto 1 do write(f,x[i]);
  writeln(f);
end;

function compara(var x,y:huge):byte;
var i:longint;
{functia ia urmatoarele valori:
0-numere egale; 1-primul nr e mai mare; 2-al doilea numar e mai mare}
begin
  while (x[0]>0) and (x[x[0]]=0) do dec(x[0]);
  while (y[0]>0) and (y[y[0]]=0) do dec(y[0]);
  if x[0]<>y[0] then begin
    if x[0]>y[0] then compara:=1
                 else compara:=2;
    exit;
  end;
  i:=x[0];
  while (i>0) and (x[i]=y[i]) do dec(i);
  if i=0 then compara:=0 else
  if x[i]>y[i] then compara:=1
               else compara:=2;
end;

procedure shlhuge(var x:huge;count:integer);
var i:integer;
begin
{inmulteste numarul cu 10^count}
  for i:=x[0] downto 1 do x[i+count]:=x[i];
  for i:=1 to count do x[i]:=0;
  inc(x[0],count);
end;

procedure aduna(var x:huge;y:huge);
var i,next:integer;
begin
{x <- x+y}
  if y[0]>x[0] then begin
    for i:=x[0]+1 to y[0] do x[i]:=0;
    x[0]:=y[0];
  end else
    for i:=y[0]+1 to x[0] do y[i]:=0;
  next:=0;
  for i:=1 to x[0] do begin
    x[i]:=x[i]+y[i]+next;
    next:=x[i] div base;
    x[i]:=x[i] mod base;
  end;
  if next>0 then begin
    inc(x[0]);
    x[x[0]]:=next;
  end;
end;

procedure scade(var x,y:huge);
var i,next:integer;
begin
{x <- x-y; x>=y}
  for i:=y[0]+1 to x[0] do y[i]:=0;
  next:=0;
  for i:=1 to x[0] do begin
    x[i]:=x[i]-(y[i]+next);
    if x[i]<0 then next:=1
              else next:=0;
    if next>0 then x[i]:=x[i]+base;
  end;
  while (x[0]>0) and (x[x[0]]=0) do dec(x[0]);
end;

procedure multiply(var x:huge; n:longint);
var i:integer;
    next:longint;
begin
  next:=0;
  for i:=1 to x[0] do begin
    x[i]:=x[i]*n+next;
    next:=x[i] div base;
    x[i]:=x[i] mod base;
  end;
  while next>0 do begin
    inc(x[0]);
    x[x[0]]:=next mod base;
    next:=next div base;
  end;
end;

procedure inmulteste(var t:huge;x,y:huge);
var i,j:integer;
    next:longint;
begin
{t <- x*y}
  t[0]:=x[0]+y[0]-1;
  for i:=1 to x[0]+y[0] do t[i]:=0;
  for i:=1 to x[0] do
    for j:=1 to y[0] do
      inc(t[i+j-1],x[i]*y[j]);
  next:=0;
  for i:=1 to t[0] do begin
    t[i]:=t[i]+next;
    next:=t[i] div base;
    t[i]:=t[i] mod base;
  end;
  if next>0 then begin
    inc(t[0]);
    t[t[0]]:=next;
  end;
end;
procedure divide(var x:huge;n:longint; var r:longint);
var i:integer;
begin
{x-deimpartitul, ia valoarea catului;
n-impartitorul;
r-restul}
  r:=0;
  for i:=x[0] downto 1 do begin
    r:=r*base+x[i];
    x[i]:=r div n;
    r:=r mod n;
  end;
  while (x[0]>0) and (x[x[0]]=0) do dec(x[0]);
end;

procedure imparte(x,y:huge;var c,r:huge);
var i:integer;
begin
{x-deimpartitul; y-impartitorul; c-catul; r-restul}
  r[0]:=0;c[0]:=x[0];
  for i:=x[0] downto 1 do begin
    shlhuge(r,1);r[1]:=x[i];
    c[i]:=0;
    while compara(y,r)<>1 do begin
      inc(c[i]);
      scade(r,y);
    end;
  end;
  while (c[0]>1) and (c[c[0]]=0) do dec(c[0]);
end;

begin
  assign(f,fin);
    reset(f);
    readln(f,n);
    for i:=1 to n do
      readln(f,a[i]);
  close(f);
  assign(f,fout);
    rewrite(f);
    unu[0]:=1;unu[1]:=1;
    new:=1;
    nr[1,0]:=unu;
    nr[1,a[1]]:=unu;
    for i:=2 to n do
      begin
        old:=new;new:=old xor 1;
        for j:=0 to 1000 do
          nr[new,j]:=nr[old,j];
        for j:=0 to 1000 do
          begin
            k:=cmmdc(a[i],j);
            aduna(nr[new,k],nr[old,j]);
          end;
      end;
    scrie(nr[new,1]);
  close(f);
end.