Cod sursa(job #10639)

Utilizator vanila0406Ionescu Victor vanila0406 Data 28 ianuarie 2007 20:36:57
Problema Pascal Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.15 kb
program kernel;
var f,g:text;
        v:array[1..100001] of longint;
        e:array[1..100001] of longint;
        p,aux:array[1..100001] of longint;
        m,n,ln,mc:longint;



procedure iofile;
begin
        assign(f,'pascal.in');
        reset(f);
        assign(g,'pascal.out');
        rewrite(g);
        readln(f,n,m);
	n:=n+1;
        if m=1 then
                begin
                        writeln(g,n);
                        close(g);
                        halt;
                end;
        close(f);
        mc:=m;
end;



procedure formaux;
var i,x,j:longint;
begin
        for i:=1 to n-1 do
                begin
                        x:=i;
                        for j:=1 to ln do
                                while x mod v[j]=0 do
                                        begin
                                                x:=x div v[j];
                                                inc(aux[j]);
                                        end;
                end;
end;


function sediv(x:longint):boolean;
var i,j,y,k,l:longint;
begin
        i:=n-1;
        j:=x-1;
        {fillchar(p,sizeof(p),0);}
        {for k:=1 to i do
                begin
                        y:=k;
                        for l:=1 to ln do
                            begin
                                while y mod v[l]=0 do
                                        begin
                                                y:=y  div v[l];
                                                inc(p[l]);
                                        end;
                            end;
                end;}
       { p:=aux;}
        {for k:=1 to i-j do
                begin}
                        y:=i-j+1;
                        for l:=1 to ln do
                                begin
                                        while y mod v[l]=0 do
                                                begin
                                                        y:=y div v[l];
                                                        inc(p[l]);
                                                end;
                                end;
               { end;}
        {for k:=1 to j do
                begin  }
                        y:=j;
                        for l:=1 to ln do
                                begin
                                        while y mod v[l]=0 do
                                                begin
                                                        y:=y div v[l];
                                                        dec(p[l]);
                                                end;
                                end;
                {end;  }
        sediv:=true;
        for k:=1 to ln do
                if p[k]<e[k] then
                        begin
                                sediv:=false;
                                exit;
                        end;
end;


procedure descm;
var i,exp,d:longint;
begin
        ln:=0;
        d:=2;
        while m<>1 do
                begin
                        exp:=0;
                        while m mod d=0 do
                                begin
                                        m:=m div d;
                                        inc(exp);
                                end;
                        if exp<>0 then
                                begin
                                        inc(ln);
                                        v[ln]:=d;
                                        e[ln]:=exp;
                                end;
                        inc(d);
                end;
end;


procedure prel;
var num,i:longint;
begin
        num:=0;
        {for i:=1 to ln do
                p[i]:=aux[i];}
        fillchar(aux,sizeof(aux),0);
        if mc=1 then num:=1;
        for i:=2 to n div 2 do
            if sediv(i) then
                inc(num);
        num:=num*2;
        if n mod 2=1 then
                if sediv(n div 2+1) then inc(num);
        writeln(g,num);
        close(g);
end;



begin
        iofile;
        descm;
        formaux;
        prel;
end.