Cod sursa(job #35675)

Utilizator raduzerRadu Zernoveanu raduzer Data 22 martie 2007 12:15:28
Problema NextSeq Scor 95
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.82 kb
var a,b,c,d:array[1..10000]of integer;
    n,m,p,i,j,z:integer;


function verif:boolean;
var i:integer;
    q:boolean;
begin
     q:=true;
     if m<>p then
     begin
          q:=false;
          verif:=q;
          exit;
     end;
     for i:=1 to m do
     begin
          if d[i]<>b[m+1-i] then
          begin
               q:=false;
               break;
          end;
     end;
     verif:=q;
end;


procedure adunare;
var t,i:integer;
begin
     t:=0;
     for i:=1 to m do
     begin
          if d[i]=n-1 then
          begin
               d[i]:=0;
               t:=1;
               continue;
          end;
          if d[i]<n-1 then
          begin
               d[i]:=d[i]+1;
               t:=0;
               break;
          end;
     end;
     if t=1 then
     begin
          m:=m+1;
          d[m]:=0;
     end;
     z:=z+1;
     if not verif then adunare;
end;



procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := c[(l+r) DIV 2];
  repeat
    while c[i] < x do i := i + 1;
    while x < c[j] do j := j - 1;
    if i <= j then
    begin
      y := c[i]; c[i] := c[j]; c[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;



begin
     assign(input,'nextseq.in');
     reset(input);
     assign(output,'nextseq.out');
     rewrite(output);
     readln(n,m,p);
     for i:=1 to n do read(c[i]);
     readln;
     for i:=1 to m do read(a[i]);
     readln;
     for i:=1 to p do read(b[i]);
     sort(1,n);
     for i:=1 to n do d[c[i]]:=i-1;
     for i:=1 to m do a[i]:=d[a[i]];
     for i:=1 to p do b[i]:=d[b[i]];
     z:=0;
     for i:=1 to m do
          d[m+1-i]:=a[i];
     adunare;
     writeln(z-1);
close(output);
end.