Cod sursa(job #465862)

Utilizator MihaicorneliuMihai Pojar Mihaicorneliu Data 25 iunie 2010 13:38:47
Problema Ratphu Scor 20
Compilator fpc Status done
Runda Stelele Informaticii 2010, gimnaziu si clasa a IX-a, Ziua 1 Marime 4.13 kb
program ratphu;
type vector=array[0..19] of byte;
var c:vector;
    f,g,h:integer;
    n,rez:int64;
    p:byte;
    i,o:text;
begin
  assign(i,'ratphu.in');reset(i);
  assign(o,'ratphu.out');rewrite(o);
  read(i,n,p);
  c[0]:=0;
  repeat
    c[0]:=c[0]+1;
    c[c[0]]:=n mod 10;
    n:=n div 10
  until n=0;
  case p of
    1:begin
        rez:=1;
        for f:=1 to c[0] do
          rez:=rez*f
      end;
    2:begin
        g:=0;
        rez:=1;
        for f:=1 to c[0] do
          if c[f] mod 2 = 0 then
            g:=g+1;
        for f:=1 to c[0]-1 do
          rez:=rez*f;
        rez:=rez*g
      end;
    3:begin
        g:=0;
        rez:=1;
        for f:=1 to c[0] do
          begin
            g:=g+c[f];
            rez:=rez*f
          end;
        if g mod 3>0 then
          rez:=0
      end;
    5:begin
        g:=0;
        rez:=1;
        for f:=1 to c[0] do
          if c[f] mod 5 = 0 then
            g:=g+1;
        for f:=1 to c[0]-1 do
          rez:=rez*f;
        rez:=rez*g
      end;
    9:begin
        g:=0;
        rez:=1;
        for f:=1 to c[0] do
          begin
            g:=g+c[f];
            rez:=rez*f
          end;
        if g mod 9>0 then
          rez:=0
      end;
    6:begin
        g:=0;
        rez:=1;
        for f:=1 to c[0] do
          g:=g+c[f];
        if g mod 3>0 then
          rez:=0
        else
          begin
            g:=0;
            rez:=1;
            for f:=1 to c[0] do
              if c[f] mod 2 = 0 then
                g:=g+1;
            for f:=1 to c[0]-1 do
              rez:=rez*f;
            rez:=rez*g
          end
       end;
    15:begin
         g:=0;
        rez:=1;
        for f:=1 to c[0] do
          g:=g+c[f];
        if g mod 3>0 then
          rez:=0
        else
          begin
            g:=0;
            rez:=1;
            for f:=1 to c[0] do
              if c[f] mod 5 = 0 then
                g:=g+1;
            for f:=1 to c[0]-1 do
              rez:=rez*f;
            rez:=rez*g
          end
       end;
    18:begin
         g:=0;
        rez:=1;
        for f:=1 to c[0] do
          g:=g+c[f];
        if g mod 9>0 then
          rez:=0
        else
          begin
            g:=0;
            rez:=1;
            for f:=1 to c[0] do
              if c[f] mod 5 = 0 then
                g:=g+1;
            for f:=1 to c[0]-1 do
              rez:=rez*f;
            rez:=rez*g
          end
       end;
    4:begin
        g:=0;
        rez:=1;
        for f:=1 to c[0]-1 do
          for h:=f+1 to c[0] do
            begin
              if (10*c[f]+c[h]) mod 4=0 then
                g:=g+1;
              if (10*c[h]+c[f]) mod 4=0 then
                g:=g+1
            end;
        for f:=1 to c[0]-2 do
          rez:=rez*f;
        rez:=rez*g
      end;
    12:begin
         g:=0;
         rez:=1;
         for f:=1 to c[0] do
           g:=g+c[f];
         if g mod 3>0 then
           rez:=0
         else
           begin
             g:=0;
             rez:=1;
             for f:=1 to c[0]-1 do
               for h:=f+1 to c[0] do
                 begin
                   if (10*c[f]+c[h]) mod 4=0 then
                     g:=g+1;
                   if (10*c[h]+c[f]) mod 4=0 then
                     g:=g+1
                 end;
             for f:=1 to c[0]-2 do
               rez:=rez*f;
             rez:=rez*g
           end
       end;
    20:begin
         g:=0;
         rez:=1;
         for f:=1 to c[0]-1 do
           for h:=f+1 to c[0] do
             begin
               if ((10*c[f]+c[h]) mod 4=0)and(c[h]=0) then
                 g:=g+1;
               if ((10*c[h]+c[f]) mod 4=0)and(c[f]=0) then
                 g:=g+1
             end;
         for f:=1 to c[0]-2 do
           rez:=rez*f;
         rez:=rez*g
       end;
    10:begin
         g:=0;
         rez:=1;
         for f:=1 to c[0] do
           if c[f]=0 then
             g:=g+1;
         for f:=1 to c[0]-1 do
           rez:=rez*f;
         rez:=rez*g
       end


  end;
  write(o,rez);
  close(o)
end.