Cod sursa(job #278832)

Utilizator adi_nmAdrian Negreanu adi_nm Data 12 martie 2009 15:47:34
Problema Numere 2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.92 kb
var d,f:array[1..10] of longint;
    n,p:int64;
    k,i,lv,gcd:integer;

function cmmdc(a,b:integer):integer;
var r:integer;
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:int64);
var i:int64;
begin
  if n mod 2=0 then begin
    inc(lv);d[lv]:=2; while n mod 2=0 do begin n:=n div 2; inc(f[lv]);end;
  end;
  i:=3;
  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); d[lv]:=i;
    while n mod i=0 do begin
      n:=n div i; inc(f[lv]);
    end;
  end;
end;

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