Cod sursa(job #197664)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 5 iulie 2008 13:39:54
Problema Grigo Scor 10
Compilator fpc Status done
Runda Junior Challenge 2008 Marime 1.3 kb
var p:array[1..1000] of longint;
    ap:Array[1..10000] of boolean;
    f,g:text;
    nr,i,poz,k,j,n,m,max:longint;
    ok:boolean;
begin
 assign(f,'grigo.in'); reset(f);
 assign(g,'grigo.out'); rewrite(g);
 read(f,n,m);
 nr:=0;
 for i:=1 to m do begin
  read(f,max);
  ap[max]:=true;
 end;
 if n=m then
  writeln(g,1)
 else begin
  for i:=1 to n do
   p[i]:=i;
  repeat
        max:=0; ok:=true;
        for i:=1 to n do begin
         if ap[i]=true then begin
          if p[i]>max then max:=p[i]
          else
           ok:=false;
         end
         else
          if p[i]>max then
           ok:=false;
        end;
        if ok then
         inc(nr);
        poz:=n;
        while (poz>1) and (p[poz]<p[poz-1]) do
                dec(poz);
        dec(poz);
        if poz<>0 then begin
                j:=poz+1;
                for i:=poz+1 to n do
                        if (p[j]>p[i]) and (p[i]>p[poz]) then
                                j:=i;
                k:=p[poz]; p[poz]:=p[j]; p[j]:=k;
                for i:=1 to (n-poz) div 2 do begin
                        k:=p[poz+i];
                        p[poz+i]:=p[n-i+1];
                        p[n-i+1]:=k;
                end;
        end;
  until poz=0;
 end;
 writeln(g,nr);
 close(f); close(g);
end.