Cod sursa(job #24193)

Utilizator ScrazyRobert Szasz Scrazy Data 1 martie 2007 21:21:08
Problema Numere 2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.96 kb
type matrix=array[1..1000000000] of longint;
var p:matrix;
    n,y,x,i,db:longint;
    f:text;

Procedure prim(var p:matrix;n:longint);
var i,j,k,x,y:longint;
    prim:boolean;

Begin
  p[1]:=2;
  k:=1;
  y:=trunc(sqrt(n));
  i:=1;
  while i<=y do
    begin
      i:=i+2;
      j:=1;
      prim:=true;
      x:=trunc(sqrt(i));
      while (p[j]<=x) and prim do
        begin
          if (i mod p[j])=0 then prim:=false;
          inc(j);
        end;
      if prim then begin k:=k+1; p[k]:=i; end;
    end;
End;

begin
  assign(f,'numere2.in');
  reset(f);
  readln(f,n);
  close(f);
  prim(p,n);
  i:=1;
  while (x<>1) and (p[i]<>0) do begin
    x:=n;
    db:=0;
    while x mod p[i]=0 do begin
      x:=x div p[i];db:=db+1;
    end;
    if x<>1 then i:=i+1;

  end;
  assign(f,'numere2.out');
  rewrite(f);
  if db<>0 then begin writeln(f,p[i]);writeln(f,db);end
  else begin writeln(f,n);writeln(f,1);end;
  close(f);

end.