Cod sursa(job #42837)

Utilizator ProtomanAndrei Purice Protoman Data 29 martie 2007 16:04:20
Problema NextSeq Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.22 kb
var i,j,n,m,p,h,ok:longint; x,y,z,a:array[1..10000] of longint; f1,f2:text;

procedure pozitie(var m:longint; p,u:longint);
var i,j,di,dj,aux:longint;
begin
di:=0;
dj:=-1;
i:=p;
j:=u;
while i<j do begin
if a[i]>a[j] then
begin
aux:=di;
di:=-dj;
dj:=-aux;
aux:=a[i];
a[i]:=a[j];
a[j]:=aux;
end;
i:=i+di;
j:=j+dj;
end;
m:=i;
end;

procedure quick(p,u:longint);
var m:longint;
begin
if p<u then begin
pozitie(m,p,u);
quick(p,m-1);
quick(m+1,u);
end;
end;

procedure search1(li,ls:longint);
var m:longint;
begin
m:=(li+ls) div 2;
if z[i]=a[m] then x[i]:=m-1
             else if li<ls then if z[i]<a[m] then search1(li,m-1)
                                             else search1(m+1,ls);
end;

procedure search2(li,ls:longint);
var m:longint;
begin
m:=(li+ls) div 2;
if z[i]=a[m] then y[i]:=m-1
             else if li<ls then if z[i]<a[m] then search2(li,m-1)
                                             else search2(m+1,ls);
end;

begin
        assign(f1,'nextseq.in');
        reset(f1);
        assign(f2,'nextseq.out');
        rewrite(f2);
        read(f1,n,m,p);
        for i:=1 to n do read(f1,a[i]);
        quick(1,n);
        for i:=p-m+1 to p do begin read(f1,z[i]); search1(1,n); end;
        for i:=1 to p-m do x[i]:=-1;
        for i:=1 to p do begin read(f1,z[i]); search2(1,n); end;
        h:=-1;
        while ok=0 do begin
                inc(h);
                for i:=p downto 1 do begin
                        if x[i]<n then begin
                                inc(x[i]);
                                if x[i]=n then begin
                                j:=i;
                                while x[j]=n do begin
                                        inc(x[j-1]);
                                        x[j]:=0;
                                        dec(j);
                                end;
                        end;
                        break;
                        end;
                        end;
                i:=1;
                while x[i]>=y[i] do begin if x[i]>y[i] then begin ok:=1; break; end; if i=p then begin ok:=1; break; end; inc(i); end;
        end;
        writeln(f2,h);
        close(f1);
        close(f2);
end.