Cod sursa(job #278306)

Utilizator basketbalistu92alexandru catalisan basketbalistu92 Data 12 martie 2009 11:13:53
Problema Numere 2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.64 kb
var f,d,n:int64;
    m,i,j:integer;
    fact:array[1..16] of byte;
    repet:array[1..355]of longint;
begin
assign(input,'numere2.in');reset(input);
assign(output,'numere2.out');rewrite(output);
readln(n);
while n<>1 do begin
  d:=2;
  f:=0;
  while n mod d<>0 do d:=d+1;
  while n mod d=0 do begin f:=f+1; n:=n div d;end;
  m:=m+1;
  fact[m]:=d;
  repet[m]:=f;
end;
for i:=2 to m do
  if repet[1]=repet[i] then begin
                             fact[1]:=fact[1]*fact[i]; repet[i]:=0;fact[i]:=0;
                            end;
for i:=1 to m do
if fact[i]>0 then write(fact[i],' ',repet[i],' ');
close(input);close(output);
end.