Cod sursa(job #279939)

Utilizator basketbalistu92alexandru catalisan basketbalistu92 Data 13 martie 2009 09:21:48
Problema Numere 2 Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.96 kb
var fact,repet:array[1..10] of longint;
    n,p:int64;
    k,gcd,i,lv:integer;
function cmmdc(a,b:longint):longint;
var r:longint;
begin
r:=a mod b;
while r<>0 do begin
  a:=b;b:=r;r:=a mod b;
end;
cmmdc:=b;
end;
procedure desc(n:longint);
var i:int64;
begin
  i:=3;
  lv:=0;
  while n mod 2=0 do begin
    inc(lv);fact[lv]:=2;while n mod 2=0 do begin n:=n div 2;inc(repet[lv]);end;
  end;
  while n<>1 do  begin
    while (n mod i<>0)and(i*i<=n) do inc(i,2);
    if i*i>n then i:=n;
    inc(lv);fact[lv]:=i;
    while n mod i=0 do begin n:=n div i;inc(repet[lv]);
    end;
  end;
end;

begin
assign(input,'numere2.in');reset(input);
assign(output,'numere2.out');rewrite(output);
readln(n);
desc(n);
gcd:=repet[1];
  for k:=2 to lv do gcd:=cmmdc(gcd,repet[k]);
  for k:=1 to lv do  repet[k]:=repet[k] div gcd;
  p:=1;
  for k:=1 to lv do
    for i:=1 to repet[k] do p:=p*fact[k];
    writeln(p);writeln(gcd);
  close(input);close(output);
  end.