Cod sursa(job #779372)

Utilizator t.g.g.tt.g.g.t t.g.g.t Data 17 august 2012 16:25:46
Problema Indep Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.64 kb
const  bz=100000000;
var a:array[1..501]of integer; rs,s:array[0..100]of longint;  ind,n,i,j,c,b,i2,j2:integer; r:longint;
d:array[1..500,1..500]of byte;
procedure put(v,z:integer);
begin
          rs[0]:=1;
          rs[1]:=2;
          if (v=0) and (z=0) then rs[1]:=1;
          for i2:=2 to ((z)+v) do
            begin
              r:=0;
              for j2:=1 to rs[0] do begin rs[j2]:=rs[j2]*2+r; r:=0; if rs[j2]>=bz then begin r:=rs[j2] div bz; rs[j2]:=rs[j2] mod bz end; end;
              if r>0 then begin inc(rs[0]); rs[rs[0]]:=r; end; r:=0;
            end;
end;
procedure adun();
begin
          if rs[0]>s[0] then s[0]:=rs[0];
          for i2:=1 to s[0] do begin s[i2]:=s[i2]+rs[i2]+r; rs[i2]:=0; r:=0; if s[i2]>=bz then begin r:=s[i2] div bz; s[i2]:=s[i2] mod bz end; end;
          if r>0 then begin inc(s[0]); s[s[0]]:=r end;r:=0;
end;
begin
assign(input,'indep.in'); reset(input);
readln(n);
for i:=1 to n do readln(a[i]);
assign(output,'indep.out'); rewrite(output);
for i:=1 to n do begin ind:=0;
  for j:=i+1 to n do
    begin
      if a[i]>a[j] then begin c:=a[i]; b:=a[j] end else begin c:=a[j]; b:=a[i] end;
      r:=0;
      repeat
        r:= c mod b;
        c:=b;
        b:=r;
      until r=0;
      if c=1 then
        begin
          d[i,j]:=1;
          put(ind,n-j);
          adun;
          for b:=i-1 downto 1 do
            if (d[b,i]=0) and (d[b,j]=0) then
              begin c:=0; for j2:=j+1 to n do if d[b,j2]=0 then inc(c); put(c,0); {writeln(a[i],' ',a[j],' ',a[b],' ',rs[1]);} adun; end;
        end else inc(ind);
    end; end;
for i:=s[0] downto 1 do write(s[i]);
close(output);
end.