Cod sursa(job #122961)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 13 ianuarie 2008 23:14:32
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.49 kb
program pairs;
type pnod=^nod;
     nod = record
           info : longint;
           urm : pnod;
           end;
var prim,urm,ultim,prim1 : pnod;
    N,i,match : integer;
    fin,fout : text;
    t1,t2 : longint;

function cmmdc(a,b:longint):integer;
var p1 : pnod;
    max : integer;
begin
max := 1;
new(p1);
p1^.info := 1;
p1^.urm := nil;
ultim := p1;
for i := 2 to (a div 2 + 1) do
if a mod i = 0 then begin
                    new(urm);
                    urm^.info := i;
                    urm^.urm := nil;
                    ultim^.urm := urm;
                    ultim := urm;
                    end;
max := 1;
while p1<>nil do begin
if (b mod p1^.info = 0) and (p1^.info <> 1) then begin
                                                 max := max+1;
                                                 break;
                                                 end;
p1 := p1^.urm;
end;
cmmdc := max;
end;
begin
match := 0;
assign(fin,'pairs.in');
reset(fin);
readln(fin,N);
new(prim);
readln(fin,prim^.info);
prim^.urm := nil;
ultim := prim;
for i := 2 to N do begin
new(urm);
readln(fin,urm^.info);
urm^.urm := nil;
ultim^.urm := urm;
ultim := urm;
end;
while prim<>nil do begin
prim1 := prim;
while prim1<>nil do begin
if (prim^.info mod prim1^.info<>0)  then if cmmdc(prim1^.info,prim^.info)=1 then match := match+1;
prim1 := prim1^.urm;
end;
prim := prim^.urm;
end;
assign(fout,'pairs.out');
rewrite(fout);
write(fout,match);
close(fout);
end.