Cod sursa(job #82222)

Utilizator gurneySachelarie Bogdan gurney Data 5 septembrie 2007 22:49:11
Problema Cifre Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.37 kb
program cifre;
  const
    fin='cifre.in';
    fout='cifre.out';
var
  s:string;
  d,z,a,b,c,k,i,j,n,x,y:longint;
  mare:boolean;

function f(x:longint):longint;
  var
    s,lg,a,b,nr,i:longint;
    st,aa:array[0..20] of longint;
    procedure back(num:longint;mare:boolean);
      var
        x,i:longint;
      begin
        if (num=lg+1)and(nr>=k) then
          begin
            x:=1;
            for i:=1 to lg do
              x:=x*st[i];
            inc(s,x);
          end
        else if (num<lg+1) then
          begin
            if mare=true then
              begin
                inc(nr);
                st[num]:=1;
                back(num+1,true);
                dec(nr);
                st[num]:=9;
                back(num+1,true);
              end
            else
              begin
                if c<aa[num] then
                  begin
                    inc(nr);
                    st[num]:=1;back(num+1,true);
                    dec(nr);
                    st[num]:=1;back(num+1,false);
                    st[num]:=aa[num]-1;back(num+1,true);
                  end
                else if c=aa[num] then
                  begin
                    inc(nr);
                    st[num]:=1;back(num+1,false);
                    dec(nr);
                    st[num]:=aa[num];back(num+1,true);
                  end
                else
                  begin
                    st[num]:=1;back(num+1,false);
                    st[num]:=aa[num];back(num+1,true);
                  end;
              end;
          end;
      end;

  begin
    if x<>-1 then
      begin
        a:=x;lg:=0;
        while a>0 do
          begin
            a:=a div 10;
            inc(lg);
          end;
        for i:=lg downto 1 do
          begin
            aa[i]:=x mod 10;
            x:=x div 10;
          end;
        s:=0;nr:=0;
        back(1,false);
        f:=s;
      end
    else
      begin
        if ((k=0)or(k=1))and(c=0) then
          f:=1
        else
          f:=0;
      end;
  end;

begin
assign(input,fin);
  reset(input);
  readln(a,b,c,k);
close(input);
assign(output,fout);
  rewrite(output);
  x:=(f(b)-f(a-1));
  y:=(b-a+1);
  d:=x div y;
  str(trunc((x/y)*10000)-d,s);
  write(d,'.');
  for i:=1 to 4-length(s) do
    write(0);
  writeln(s);
close(output);
end.