Cod sursa(job #25592)

Utilizator vanila0406Ionescu Victor vanila0406 Data 4 martie 2007 13:03:19
Problema Zero 2 Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.14 kb
program zero2;
type fact=record
        f,e:qword;
end;
var f,g:text;
        v,aux:array[1..1000000] of fact;




procedure prel(n,b:longint);
var
        d,i,j,e,exp,lv,y:longint;
begin
        d:=2;
        lv:=0;
        while b<>1 do
                begin
                        e:=0;
                        while b mod d=0 do
                                begin
                                        inc(e);
                                        b:=b div d;
                                end;
                        if e<>0 then
                                begin
                                        inc(lv);
                                        v[lv].f:=d;
                                        v[lv].e:=e;
                                end;
                        inc(d);
                end;
        for i:=1 to lv do
                aux[i].e:=0;
        for i:=2 to n do
                begin
                        exp:=n-i+1;
                        y:=i;
                        for j:=1 to lv do
                                begin
                                        if v[j].f>y then
                                                break;
                                        e:=0;
                                        while y mod v[j].f=0 do
                                                begin
                                                        y:=y div v[j].f;
                                                        inc(e);
                                                end;
                                        if e<>0 then
                                                aux[j].e:=aux[j].e+exp*e;
                                end;
                end;
        writeln(g,aux[lv].e div v[lv].e);
end;



procedure iofile;
var i,n,b:longint;
begin
        assign(f,'zero2.in');
        reset(f);
        assign(g,'zero2.out');
        rewrite(g);
        for i:=1 to 10 do
                begin
                        readln(f,n,b);
                        prel(n,b);
                end;
        close(g);
end;

begin
        iofile;
end.