Cod sursa(job #465821)

Utilizator marta_diannaFII Filimon Marta Diana marta_dianna Data 25 iunie 2010 13:25:50
Problema Ratphu Scor 40
Compilator fpc Status done
Runda Stelele Informaticii 2010, gimnaziu si clasa a IX-a, Ziua 1 Marime 2.8 kb
program p1;
var f,g:text;
    fr:array[0..9] of longint;
    a:array[1..20] of longint;
    viz,x:array[1..20] of integer;
    p,nr,s,ok,number:longint;
    n:int64;

function numberf(x:int64):longint;
var m:longint;
begin
    m:=0;
    while x>0 do
    begin
        m:=m+1;
        fr[x mod 10]:=fr[x mod 10]+1;
        a[m]:=x mod 10;
        s:=s+x mod 10;
        x:=x div 10;
    end;
    numberf:=m;
end;

function fact(x:longint):int64;
var prod:int64;
    i:longint;
begin
     prod:=1;
     for i:=2 to x do
     prod:=prod*i;
     fact:=prod;
end;

procedure caz1;
begin
     if p=1 then begin writeln(g,fact(nr));ok:=1;end
     else if (p in [3,9])and(s mod p=0) then begin writeln(g,fact(nr));ok:=1;end
          else if (p in [3,9]) then begin writeln(g,0);ok:=1;end;
end;

procedure caz2;
begin
     if (p=5)or((p=15)and(s mod 3=0)) then
     begin writeln(g,(fr[5]+fr[0])*fact(nr-1));ok:=1;end
     else if p=15 then begin writeln(g,0);ok:=1;end;
     if p=10 then begin writeln(g,fr[0]*fact(nr-1));ok:=1;end;
end;

procedure caz3;
var sum:longint;
    rez:int64;
begin
     sum:=fr[0]+fr[2]+fr[4]+fr[6]+fr[8];
     rez:=sum*fact(nr-1);
     if p=2 then begin writeln(g,rez);ok:=1;end;
     if p=18 then
     begin
        if s mod 9=0 then writeln(g,rez)
        else writeln(g,0);
        ok:=1;
     end;
     if p=6 then
     begin
        if s mod 3=0 then writeln(g,rez)
        else writeln(g,0);
        ok:=1;
     end;
end;

procedure caz4;
var i,pos,j,nn:longint;
    rez:int64;
begin
    if (p=4) or (p=12) then
    begin
    ok:=1;
    if (p=12)and(s mod 3>0) then writeln(g,0)
    else
    begin
        pos:=0;
        for i:=1 to nr do
        for j:=1 to nr do
        if i<>j then
        begin
              nn:=a[i]*10+a[j];
             if nn mod 4=0 then pos:=pos+1;
        end;
        rez:=fact(nr-2)*pos;
        writeln(g,rez);
    end;
    end;
end;

procedure vezi;
var xx:int64;
    i:longint;
begin
    xx:=0;
    for i:=1 to nr do
    xx:=xx*10+x[i];
    if xx mod p=0 then number:=number+1;
end;

procedure back(k:integer);
var i:longint;
begin
     if k=nr+1 then vezi
     else for i:=1 to nr do
              if viz[i]=0 then
              begin

                   x[k]:=a[i];
                   viz[i]:=1;
                   back(k+1);
                   viz[i]:=0;
              end;
end;

begin
    assign(f,'ratphu.in');reset(f);
    assign(g,'ratphu.out');rewrite(g);
    read(f,n,p);
    s:=0;
    nr:=numberf(n);
    ok:=0;
    caz1;{1,3,9}
    if ok=0 then caz2;{5,15,10}
    if ok=0 then caz3;{2,6,18}
    if ok=0 then caz4;{4,12}
    if ok=0 then
    begin
        number:=0;
        back(1);
        writeln(g,number);
    end;
    close(f);
    close(g);
end.