Cod sursa(job #39322)

Utilizator ProtomanAndrei Purice Protoman Data 26 martie 2007 17:14:51
Problema Pascal Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.96 kb
var p,s,s1,s2,x,d,r,i,h,c:longint; f1,f2:text; v,z:array[0..5000] of longint;

procedure putere(x:longint);
begin
p:=1;s:=0;while p*d<=x do begin p:=p*d;s:=s+x div p;end;
end;

begin
     assign(f1,'pascal.in');reset(f1);assign(f2,'pascal.out');rewrite(f2);read(f1,r,d);
     c:=d;
     if d=4 then d:=2;
     if c<>6 then putere(r);
     if c=6 then begin d:=2; putere(r); s1:=s; d:=3; putere(r); s2:=s; end;
     inc(r);
     d:=c;
     s2:=s;
     if c<>6 then for i:=1 to r do begin if c=4 then d:=2;putere(i-1);v[i]:=s;end;
     if c=6 then for i:=1 to r do begin
         d:=3; putere(i-1); v[i]:=s; d:=2; putere(i-1); z[i]:=s;
     end;
     if c<>6 then for i:=1 to r do begin
     if c=4 then if s2 div 2>(v[i]+v[r+1-i]) div 2 then inc(h);
     if c<>4 then if s2>v[i]+v[r+1-i] then inc(h); end;
     if c=6 then for i:=1 to r do
     if (s2>v[i]+v[r+1-i])and(s1>z[i]+z[r+1-i]) then inc(h);
     writeln(f2,h);
     close(f1);
     close(f2);
end.