Cod sursa(job #273319)

Utilizator sziliMandici Szilard szili Data 8 martie 2009 14:18:32
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.64 kb
program olimpi;
var

tenyszam:array[1..100000] of integer;
a:array[1..100000,1..10] of integer;
f,g:text;
m,db,i,j,r1,r2,szam,szama,oszto:integer;
oan:boolean;

begin
        assign(f,'pairs.in');
        reset(f);

        assign(g,'pairs.out');
        rewrite(g);


        readln(f,m);

        db:=0;

        for i:=1 to m do
        begin
        readln(f,szam);

        {felbontujuk prim tenyezokre:D}

        oszto:=2;
        szama:=0;

        while szam<>1 do
        begin

        if szam mod oszto=0 then begin

        inc(szama);
        a[i,szama]:=oszto;
        end;

                while szam mod oszto=0 do
                szam:=szam div oszto;

        inc(oszto);

        tenyszam[i]:=szama;

        end;





        end;


        {data is read}

        db:=0;

        for i:=1 to m-1 do
        begin
                for j:=i+1 to m do
                begin
                oan:=true;

                r1:=1;
                r2:=1;

                while (r1<=tenyszam[i]) and (r2<=tenyszam[j]) do
                begin
                     if a[i,r1]=a[j,r2] then
                                        begin
                                              oan:=false;
                                              break;
                                        end;

                     if a[i,r1]<a[j,r2] then
                        inc(r1)
                     else
                     inc(r2);


                end;

                if oan then inc(db);

                end;
        end;


        writeln(g,db);


        close(g);


end.