Cod sursa(job #197698)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 5 iulie 2008 13:59:21
Problema Grigo Scor 0
Compilator fpc Status done
Runda Junior Challenge 2008 Marime 1.74 kb
program grigo;
var f,g:Text;
    a,v,c:array[0..100000]of longint;
    n,s,m,i,x,p,j:longint;

function part(p,r:longint):longint;
var x,i,j,aux:longint;
begin
  x:=v[p];
  i:=p-1;
  j:=r+1;
  while true do
    begin
      repeat dec(j);
        until v[j]<=x;
      repeat inc(i);
        until v[i]>=x;
      if (i<j)then
        begin
          aux:=v[i];
          v[i]:=v[j];
          v[j]:=aux;
        end else
        begin
          part:=j;
          break;
        end;
    end;
end;

procedure quick(p,r:longint);
var q,i:longint;
begin
  if (p<r)then
    begin
      q:=part(p,r);
      quick(p,q);
      quick(q+1,r);
    end;
end;

function comb(n,k:longint):longint;
var o,i:longint;
begin
  o:=1;
  for i:=n downto n-k+1 do
    o:=o*i mod 1000003;
  comb:=o;
end;

begin
assign(f,'grigo.in');
assign(g,'grigo.out');
reset(f);
rewrite(g);
read(f,n,m);
for i:=1 to m do read(F,v[i]);
quick(1,m);
if (v[1]<>1)then
  write(g,0)else
begin
for i:=1 to m-1 do
  a[i]:=v[i+1]-1;
for i:=1 to m-1 do
  c[i]:=comb(a[i]-a[i-1]-1,v[i+1]-v[i]-1);
a[m]:=n;
dec(m);
x:=comb(n-v[m+1],n-v[m+1]);
a[0]:=1;
s:=0;
while true do
  begin
    p:=x;
    i:=m;
    while (i>=1)do
      begin
        if (a[i]<n-m+i-1)then
          begin
            for j:=1 to m do p:=p*c[j] mod 1000003;
            inc(a[i]);
            for j:=i+1 to m do
              if (v[i+1]-1>a[j-1]+1)then a[j]:=v[i+1]-1 else
              a[j]:=a[j-1]+1;
            for j:=i to m do
              c[j]:=comb(a[i]-a[i-1]-1,v[i+1]-v[i]-1);
            break;
          end;
        dec(i);
      end;

    if (i=0)then break;
    inc(s,p);
    s:=s mod 1000003;
  end;
write(g,s);
end;
close(f);
close(g);
end.