Cod sursa(job #122970)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 13 ianuarie 2008 23:41:04
Problema Pairs Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.44 kb
program pairs;
type pnod=^nod;
     nod = record
           info : integer;
           urm : pnod;
           end;
var prim,urm,ultim,prim1 : pnod;
    N,i,match : integer;
    f : text;
function cmmdc(a,b:longint):byte;
var p1 : pnod;
begin
new(p1);
p1^.info := 1;
p1^.urm := nil;
ultim := p1;
for i := 2 to a div 2 do
if a mod i = 0 then begin
                    new(urm);
                    urm^.info := i;
                    urm^.urm := nil;
                    ultim^.urm := urm;
                    ultim := urm;
                    end;
cmmdc := 1;
while p1<>nil do begin
if (b mod p1^.info = 0) and (p1^.info <> 1) then begin
                                                 cmmdc := 2;
                                                 dispose(p1);
                                                 break;
                                                 end;
p1 := p1^.urm;
end;
end;
begin
match := 0;
assign(f,'pairs.in');
reset(f);
readln(f,N);
new(prim);
readln(f,prim^.info);
prim^.urm := nil;
ultim := prim;
for i := 2 to N do begin
new(urm);
readln(f,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(f,'pairs.out');
rewrite(f);
write(f,match);
close(f);
end.