Cod sursa(job #465806)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 25 iunie 2010 13:15:27
Problema Ratphu Scor 20
Compilator fpc Status done
Runda Stelele Informaticii 2010, gimnaziu si clasa a IX-a, Ziua 1 Marime 7.03 kb
{7,11,13,17,19}
program alex;
var f:text;
    n,z,x,sum:int64;
    a,st,viz:array[0..20]of integer;
    cifpar,cifimp,zero,cinci,nr,s,c,p,i,k,j,d7,d11,d13,d17,d19:longint;
    as,ev:boolean;
begin
assign(f,'ratphu.in');reset(f);
readln(f,n,p);
close(f);
cifpar:=0;
cifimp:=0;
zero:=0;
cinci:=0;
nr:=0;
s:=0;
x:=n;
k:=0;
while n<>0 do
      begin
      c:=n mod 10;
      n:=n div 10;
      s:=s+c;
      if c mod 2=0 then inc(cifpar)
                   else inc(cifimp);
      if c=0 then inc(zero);
      if c=5 then inc(cinci);
      s:=s+c;
      nr:=nr+1;
      k:=k+1;
      a[k]:=c;
      end;
cinci:=cinci+zero;
assign(f,'ratphu.out');rewrite(f);
if p=x then begin
            z:=1;
            for i:=2 to nr do
                z:=z*i;
            writeln(f,z);
            end
       else begin
            z:=0;
case p of
1:begin
  z:=1;
  for i:=2 to nr do
       z:=z*i;
  writeln(f,z);
  end;
2:begin
  z:=1;
  for i:=2 to nr-1 do
      z:=z*i;
  z:=z*cifpar;
  writeln(f,z);
  end;
3:begin
  if s mod 3=0 then begin
                    z:=1;
                    for i:=2 to nr do
                        z:=z*i;
                    writeln(f,z);
                    end
               else writeln(f,0);
  end;
4:begin
  if cifpar<2 then writeln(f,0);
  end;
5:begin
  if cinci=0 then writeln(f,0)
             else begin
                  z:=1;
                  for i:=2 to nr-1 do
                      z:=z*i;
                  z:=z*cinci;
                  writeln(f,z);
                  end;
  end;
6:begin
  if s mod 3=0 then begin
                    if cifpar=0 then writeln(f,0)
                                else begin
                                     z:=1;
                                     for i:=2 to nr-1 do
                                         z:=z*i;
                                     z:=z*cifpar;
                                     writeln(f,z);
                                     end;
                    end
               else writeln(f,0);
  end;
8:begin
  if cifpar=0 then writeln(f,0);
  end;
9:begin
  if s mod 9<>0 then writeln(f,0)
                else begin
                     z:=1;
                     for i:=2 to nr do
                         z:=z*2;
                     writeln(f,z);
                     end;
  end;
10:begin
   if zero=0 then writeln(f,0)
             else begin
                  z:=1;
                  for i:=2 to nr-1 do
                      z:=z*i;
                  z:=z*zero;
                  writeln(f,z);
                  end;
   end;
12:begin
   if(s mod 3<>0)or(cifpar=0)then writeln(f,0);
   end;
14:begin
   if cifpar=0 then writeln(f,0);
   end;
15:begin
   if s mod 3=0 then begin
                     if cinci=0 then writeln(f,0)
                                else begin
                                    z:=1;
                                    for i:=2 to nr-1 do
                                        z:=z*i;
                                    z:=z*cinci;
                                    writeln(f,z);
                                    end;
                     end
                else writeln(f,0);
   end;
16:begin
   if cifpar<2 then writeln(f,0);
   end;
18:begin
   if s mod 9=0 then begin
                     if cifpar=0 then writeln(f,0)
                                 else begin
                                      z:=1;
                                      for i:=2 to nr-1 do
                                          z:=z*i;
                                      z:=z*cifpar;
                                      writeln(f,z);
                                      end;
                     end
                else writeln(f,0);
   end;
20:begin
   if zero=0 then writeln(f,0)
             else begin
                  if zero=1 then begin
                                 if cifpar=0 then writeln(f,0)
                                             else begin
                                                  z:=1;
                                                  for i:=2 to nr-2 do
                                                      z:=z*i;
                                                  z:=z*cifpar;
                                                  writeln(f,z);
                                                  end;
                                 end
                            else begin
                                 z:=1;
                                 for i:=2 to nr-2 do
                                     z:=z*i;
                                 if cifpar<>0 then z:=z*zero*cifpar
                                              else z:=z*zero;
                                 writeln(f,z);
                                 end;
                  end;
   end;
7,11,13,17,19:begin
              j:=1;
              st[j]:=0;
              while j>0 do
                    begin
                    repeat
                    if st[j]<k then begin
                                    st[j]:=st[j]+1;
                                    as:=true;
                                    end
                               else as:=false;
                    if as then begin
                               if viz[st[j]]=0 then begin
                                                    ev:=true;
                                                    viz[st[j]]:=1;
                                                    end
                                           else ev:=false;
                               end;
                    until(not as)or(as and ev);
                    if as then begin
                               if j=k then begin
                                           sum:=0;
                                           for i:=1 to j do
                                               sum:=sum*10+a[st[i]];
                                           if sum mod 7=0 then inc(d7);
                                           if sum mod 11=0 then inc(d11);
                                           if sum mod 13=0 then inc(d13);
                                           if sum mod 17=0 then inc(d17);
                                           if sum mod 19=0 then inc(d19);
                                           end
                                      else begin
                                           j:=j+1;
                                           st[j]:=0;
                                           end;
                               end
                          else begin
                          viz[st[j]]:=0;
                               st[j]:=0;
                               viz[st[j-1]]:=0;
                               j:=j-1;
                               end;
                    end;
              if p=7 then writeln(f,d7);
              if p=11 then writeln(f,d11);
              if p=13 then writeln(f,d13);
              if p=17 then writeln(f,d17);
              if p=19 then writeln(f,d19);
              end;
end;
           end;
close(f);
end.