Cod sursa(job #465702)

Utilizator lianaliana tucar liana Data 25 iunie 2010 12:13:28
Problema Ratphu Scor 10
Compilator fpc Status done
Runda Stelele Informaticii 2010, gimnaziu si clasa a IX-a, Ziua 1 Marime 3.88 kb
program ratphu;
var f, g:text;
    j, k, z, np, nr, rez, i, p, n, nc, rez20, s, n0, n5:longint;
    ok, gasit:boolean;
    v, sol, fol, vct:array[0..20] of longint;

function fact(a:longint):longint;
var iii:longint;
  begin
    fact:=1;
    for iii:=1 to a do
      fact:=fact*iii;
  end;

procedure cazuri;
  begin
    ok:=true;
    if p mod 3=0 then
      begin
        if s mod 3>0 then
          ok:=false;
        if (p=3) or (p=9) then
          begin
            if p=9 then
              if s mod 9=0 then
                 writeln(g,fact(nc))
                else
                  writeln(g,0);
            if p=3 then
              writeln(g,fact(nc));
            gasit:=true;
          end;
      end;
    if p mod 2=0 then
      begin
        if ((p=2) or (p=6) or (p=18)) and (ok) then
          begin
            writeln(g,fact(nc-1)*np);
            gasit:=true;
          end;
        if (p=4) or (p=12) or (p=20) then
          begin
            rez:=0;
            gasit:=true;
            for i:=1 to nc do
              for j:=1 to nc do
                if i<>j then
                  begin
                    if (vct[i]*10+vct[j]) mod 4=0 then
                      rez:=rez+1;
                    if (p=20) and ((vct[i]*10+vct[j]) mod 4=0) and (vct[j]=0) then
                      rez20:=rez20+1;
                  end;
           if (p=4) or ((p=12) and ok) then
             writeln(g,rez*fact(nc-2));
           if p=20 then
             writeln(g,rez20*fact(nc-2));
          end;
        if p=8 then
          begin
            rez:=0;
            gasit:=true;
            for i:=1 to nc do
              for j:=1 to nc do
                if i<>j then
                  for k:=1 to nc do
                    if (i<>k) and (j<>k) then
                      if (vct[i]*100+vct[j]*10+vct[k]) mod 8=0 then
                        rez:=rez+1;
           writeln(g,rez*fact(nc-3));
          end;
        if p=16 then
          begin
            rez:=0;
            gasit:=true;
            for i:=1 to nc do
              for j:=1 to nc do
                if i<>j then
                for k:=1 to nc do
                  if (k<>i) and (k<>j) then
                  for z:=1 to nc do
                    if (z<>k) and (z<>i) and (z<>j) then
                      if (v[i]*1000+v[j]*100+v[k]*10+v[z]) mod 16=0 then
                        rez:=rez+1;
            writeln(g,rez*fact(nc-4));
          end;
      end;
    if (p=5) or (p=15) then
      begin
        n0:=v[0];
        n5:=v[5];
        if (p=5) or ((p=15) and ok) then
          writeln(g,(n0+n5)*fact(nc-1));
        gasit:=true;
      end;
   if p=10 then
     begin
       writeln(g,v[0]*fact(nc-1));
       gasit:=true;
     end;
   if p=1 then
     begin
       writeln(g,fact(nc));
       gasit:=true;
     end;
  end;

procedure desc;
var nn, cf:longint;
  begin
    nn:=n;
    while n>0 do
      begin
        cf:=n mod 10;
        v[cf]:=v[cf]+1;
        s:=s+cf;
        if cf mod 2=0 then
          np:=np+1;
        n:=n div 10;
        nc:=nc+1;
        vct[nc]:=cf;

      end;
    n:=nn;
  end;

procedure verificare;
  begin
    nr:=0;
    for i:=1 to nc do
      nr:=nr*10+vct[sol[i]];
    if nr mod p=0 then
      rez:=rez+1;
  end;

procedure gen(k:longint);
var ii:longint;
  begin
    if k=nc+1 then
      verificare
     else
       begin
         for ii:=1 to nc do
           if fol[ii]=0 then
           begin
             sol[k]:=vct[ii];
             fol[ii]:=1;
             gen(k+1);
             fol[ii]:=0;
           end;
       end;
  end;

  begin
    assign(f,'ratphu.in'); reset(f);
    assign(g,'ratphu.out'); rewrite(g);
    readln(f,n,p);
    desc;
    cazuri;
    if not gasit then
      begin
        gen(1);
        writeln(g,rez);
      end;
    close(f);
    close(g);
  end.