Cod sursa(job #258193)

Utilizator MihaiBunBunget Mihai MihaiBun Data 14 februarie 2009 20:34:41
Problema Pascal Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.49 kb
program pascal;
var f:text;
    r,d,i,nr,x,p,s,s1:longint;
begin
  assign(f,'pascal.in');
  reset(f);
  readln(f,r,d);
  close(f);
  assign(f,'pascal.out');
  rewrite(f);
  case d of
  2,3,5:begin
           nr:=0;
           for i:=1 to r div 2 do
             begin
               x:=r;
               s:=0;
               p:=d;
               while (x div p)<>0 do
                begin
                  s:=s+x div p;
                  p:=p*d
                end;
               x:=i;
               p:=d;
               while (x div p)<>0 do
                begin
                  s:=s-x div p;
                  p:=p*d
                end;
               x:=r-i;
               p:=d;
               while (x div p)<>0 do
                begin
                  s:=s-x div p;
                  p:=p*d
                end;
               if s>0 then nr:=nr+1
             end;
             if r mod 2=1 then nr:=nr*2
                         else if s>0 then nr:=(nr-1)*2+1
                                     else nr:=nr*2
        end;
      4:begin
           nr:=0;
           d:=2;
           for i:=1 to r div 2 do
             begin
               x:=r;
               s:=0;
               p:=d;
               while (x div p)<>0 do
                begin
                  s:=s+x div p;
                  p:=p*d
                end;
               x:=i;
               p:=d;
               while (x div p)<>0 do
                begin
                  s:=s-x div p;
                  p:=p*d
                end;
               x:=r-i;
               p:=d;
               while (x div p)<>0 do
                begin
                  s:=s-x div p;
                  p:=p*d
                end;
               if s>1 then nr:=nr+1
             end;
              if r mod 2=1 then nr:=nr*2
                         else if s>0 then nr:=(nr-1)*2+1
                                     else nr:=nr*2
        end;
      6:begin
          nr:=0;

           for i:=1 to r div 2 do
             begin
               d:=2;
               x:=r;
               s:=0;
               p:=d;
               while (x div p)<>0 do
                begin
                  s:=s+x div p;
                  p:=p*d
                end;
               x:=i;
               p:=d;
               while (x div p)<>0 do
                begin
                  s:=s-x div p;
                  p:=p*d
                end;
               x:=r-i;
               p:=d;
               while (x div p)<>0 do
                begin
                  s:=s-x div p;
                  p:=p*d
                end;
                d:=3;
               x:=r;
               s1:=0;
               p:=d;
               while (x div p)<>0 do
                begin
                  s1:=s1+x div p;
                  p:=p*d
                end;
               x:=i;
               p:=d;
               while (x div p)<>0 do
                begin
                  s1:=s1-x div p;
                  p:=p*d
                end;
               x:=r-i;
               p:=d;
               while (x div p)<>0 do
                begin
                  s1:=s1-x div p;
                  p:=p*d
                end;
               if (s>0)and(s1>0) then nr:=nr+1
             end;
             if r mod 2=1 then nr:=nr*2
                          else if s>0 then nr:=(nr-1)*2+1
                                      else nr:=nr*2
        end;
  end;
writeln(f,nr);
close(f)
end.