Cod sursa(job #503237)

Utilizator lianaliana tucar liana Data 22 noiembrie 2010 09:33:14
Problema GFact Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.47 kb
program factorial;
var f, g:text;
    m, st, dr, pp, p, nfp, d, min, q, x, pac:int64;
    fp, put:array[0..50] of longint;
    i:longint;

procedure descompunere;
  begin
    d:=2;
    pp:=p;
    while d*d<=pp do
      begin
        if pp mod d=0 then
          begin
            nfp:=nfp+1;
            fp[nfp]:=d;
            while pp mod d=0 do
              begin
                put[nfp]:=put[nfp]+1;
                pp:=pp div d;
              end;
          end;
        d:=d+1;
      end;
    if pp>1 then
      begin
        nfp:=nfp+1;
        fp[nfp]:=pp;
        put[nfp]:=1;
      end;
  end;

procedure calculare;
  begin
    min:=maxlongint;
    for i:=1 to nfp do
      begin
        d:=fp[i];
        x:=m;
        pac:=0;
        while x>0 do
          begin
            x:=x div d;
            pac:=pac+x;
          end;
        if pac div put[i]<min then
          min:=pac div put[i];
      end;
  end;

procedure cautare;
  begin
    st:=1;
    dr:=p*q;
    while st<=dr do
      begin
        m:=st+(dr-st)div 2;
        calculare;
        if min>=q then
          dr:=m-1
         else
           st:=m+1;
      end;
    writeln(g,st);
  end;

  begin
    assign(f,'gfact.in'); reset(f);
    assign(g,'gfact.out'); rewrite(g);
    readln(f,p,q);
    if p=1 then
      begin
        writeln(g,1);
        close(g);
        halt;
      end;
    descompunere;
    cautare;
    close(f);
    close(g);
  end.