Cod sursa(job #26915)

Utilizator bogdan315Popescu Bogdan-Ionut bogdan315 Data 5 martie 2007 22:29:57
Problema Puteri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.68 kb
type vec=array[1..100]of record
     x,y,z:byte;
     end;
var n,i,s,r,j,e:integer;
    f,g:text;
    a:vec;
    b:array[1..100]of integer;
function pow2(p:integer):integer;
var j:integer;
begin     e:=2;
if p=0 then e:=1
   else
for j:=1 to p-1 do
    e:=e*2;
pow2:=e;
end;
function pow3(p:integer):integer;
var j:integer;
begin     e:=3;
if p=0 then e:=1
   else
for j:=1 to p-1 do
    e:=e*3;
pow3:=e;
end;
function pow5(p:integer):integer;
var j:integer;
begin     e:=5;
if p=0 then e:=1
   else
for j:=1 to p-1 do
    e:=e*5;
pow5:=e;
end;
function ver(m:integer):boolean;
var t:boolean;
    d,nr,k,d1,k1,l,k2:integer;
begin
t:=true;  K:=m;k1:=k;
for d:=2 to trunc(sqrt(m)) do
    begin   nr:=0;
    if m mod d=0 then
       while m mod d=0 do
             begin
             m:=m div d;
             inc(nr);
             end;
       if nr mod 2=1 then
          begin
          t:=false;
          break;
          end;
    end;
nr:=0;    k2:=1;
if t=false then
   begin
   for d:=2 to trunc(sqrt(k)) do
    begin
    if k mod d=0 then
       while k mod d=0 do
             begin
             d1:=d;
             k:=k div d;
             inc(nr);
             end;
    for l:=1 to nr do k2:=k2*d1;
    if k2=k1 then t:=true;
    end;
   end;
ver:=t;
end;
begin
assign(f,'puteri.in');reset(f);
assign(g,'puteri.out');rewrite(g);
readln(f,n);
for i:=1 to  n do
    readln(f,a[i].x,a[i].y,a[i].z);
for i:=1 to n do
    begin
    b[i]:=pow2(a[i].x)*pow3(a[i].y)*pow5(a[i].z);
    end;
for i:=1 to n-1 do
for j:=i+1 to n do
    begin
    r:=b[i]*b[j];
    if ver(r)=true then inc(s);
    end;
write(g,s);
close(f);close(g);
end.