Cod sursa(job #58096)

Utilizator gurneySachelarie Bogdan gurney Data 3 mai 2007 23:53:28
Problema Indep Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 5.91 kb
program indep;
  const
    fin='indep.in';
    fout='indep.out';
    prim:array[0..168] of integer=(168,2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,
    233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,
    547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,
    877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997);
    base=10;
    nmax=500;
type huge=array[0..1000] of longint;
var
    f:text;
    v,u,w,c,r:huge;
    i,j,k,cnt:longint;
    n,rest:longint;
    ch:char;
    a:array[1..nmax] of integer;
    bin:array[0..nmax] of huge;
    d:array[1..1000] of longint;
    unu:huge;
    old,new:integer;

procedure descompune(i:integer;var cnt:longint);
  var
    j,k:integer;
  begin
    cnt:=0;
    j:=2;
    while i<>1 do
      begin
        if i mod j=0 then
          begin
            inc(cnt);
            i:=i div j;
            if i mod j=0 then
              begin
                cnt:=-1;
                exit;
              end;
          end;
        inc(j);
      end;
  end;

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;
    bin[0]:=unu;
    for i:=1 to n do
      begin
        bin[i]:=bin[i-1];
        multiply(bin[i],2);
      end;
    w:=bin[n];
    scade(w,unu);
    for i:=2 to 1000 do
      begin
        descompune(i,cnt);
        if cnt<>-1 then
          begin
            k:=0;
            for j:=1 to n do
              if a[j] mod i=0 then
                inc(k);
            v:=bin[k];scade(v,unu);
            if cnt and 1=1 then
              scade(w,v)
            else
              aduna(w,v);
          end;
      end;
    scrie(w);
  close(f);
end.