Похожие массивы

[Fellics{новичок}]

Всем доброго времени суток.
Прошу помощи в оптимизации кода. Дело в том, что я решаю эту задачу http://informatics.mccme.ru/moodle/m...&chapterid=767 и почти решил, только она у меня на 43 тесте валится, пишет "Превышено максимальное время работы". Пытался оптимизировать код, как видите здесь 2 вида сортировки, но я пользуюсь обоими, тем не менее может мне Вы подскажете, как оптимизировать код для того что бы он выполнялся до менее одной секунды?
Собственно код:

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type matrix=array[1..100000] of integer;
  var i,j,n,k:integer;
   a,b:matrix;

   procedure swap(var a,b:Integer);
   var sw:integer;
   begin
     sw:=a;
     a:=b;
     b:=sw;
   end;
   procedure sort(var a:matrix; n:Integer);
   var i,j,Min,Max,P:Integer;
   begin
     for i:=1 to n div 2 do 
begin 
if A[i]>A[i+1] then 
begin 
Min:=i+1; 
Max:=i; 
end 
else 
begin
Min:=i;
Max:=i+1;
end; 
for j:=i+2 to n-i+1 do 
if A[j]>A[Max] then 
Max:=j 
else 
if A[j]<A[Min] then 
Min:=j; 
{Îáìåí ýëåìåíòîâ} 
P:=A[i];
A[i]:=A[min]; 
A[min]:=P; 
if max=i then 
max:=min; 
P:=A[N-i+1];
A[N-i+1]:=A[max]; 
A[max]:=P; 
end;
   end;
   procedure past(var a:matrix; n:Integer);
   var key,j,i:Integer;
   begin
      for i:=1 to n do
     begin
     key := A[i] ;
      j := i - 1;
      while ( j > 0) and (A[j] > key) do
     begin
        A[j + 1] := A[j] ;
        j := j - 1 ;
     A[j + 1] := key;
     end;
     end;

   end;
   procedure writemas(var a:matrix;n:integer);
   var i:integer;
   begin
     for i:=1 to n do
     Write(a[i],' ');
   end;


begin
  { TODO -oUser -cConsole Main : Insert code here }
    Read(n);
    for i:=1 to n do
     Read(a[i]);
    read(k);
    for i:=1 to k do
     Read(b[i]);
   sort(a,n);
   sort(b,k);

  i:=1;
  j:=1;
    while (i<n) and (j<k)  do
    begin
     if a[i]<>b[j] then Break;
     while a[i]=a[i+1] do
     i:=i+1;
     while b[j]=b[j+1] do
     j:=j+1;
    i:=i+1;
    j:=j+1;

    end;
 if a[i]<>b[j] then WriteLn('NO') else WriteLn('YES');

//Read(n);

end.

[Fellics{новичок}]

Тему можно закрывать, сейчас у меня эта программка летает, вроде даже за время менее одной десятой секунды, правда памяти прилично видимо требует =)

[Stilet]

Предлагаю свое видение решения:

program Project1;

{$APPTYPE CONSOLE}

uses   {$o-}
  SysUtils;
const n= 100000;
var a:array[1.. 100000] of integer;
 q,w:array of integer;
 i:integer;
begin
Randomize; i:=random(n);SetLength(q,i);
Randomize; i:=random(n);SetLength(w,i);
 i:=0;while (i<=high(q))or(i<=high(w)) do begin
  if (i<=high(q)) then q[i]:=random(5);
  if (i<=high(w)) then w[i]:=random(50);
  a[q[i]]:=1;
  //writeln(q[i]:10,w[i]:10);
  inc(i);
 end;
 i:=0;while (i<=high(q))or(i<=high(w)) do begin
  if a[w[i]]=0 then begin
   write('no');readln;halt;
  end;
  inc(i);
 end;
  { TODO -oUser -cConsole Main : Insert code here }
  write('yes');
 readln;
end.

Правда я не измерял скорость но по-моему менее секунды на моем КорДуо
Смысл понятен?