Метод Шейкера, обнуляет максимальный элемент, почему?

[leshij]

Всем привет!
Сортируя массив методом шейкера, почему-то максимальный элмент обнуляет и ставит вверх массива, остальные же цыфры упорядычивает как надо

 procedure SheikerSort(var A: array of integer; var N: integer; var S, P: integer);
var
  i,j,l, min, max: integer;
begin
  for i:=0 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 do
    if A[j]>A[max] then max:= j
    else if A[j]<A[min] then min:=j;
    inc(P);
    change(A[i], A[min]);
    if max=i then max:= min;
    inc(P);
    change(A[N-i], A[max]);
  end;
end;

в чём проблема? как понимаю что где-то видать выходит за границы массива и вписывает ноль, но где??

[__STDC__]

Меньше всего хочется в Вашем коде разбираться... Вообще хорошо бы было полностью код программы посмотреть, потому что когда я использую Вашу процедуру, у меня ничего не зануляется..
Вот такой у меня текст, процедуру сортировки я не менял вообще.. ну что было нужно - дописал.. Сравните со своим что ли..
P.S. Уж извините, все без отступов и прочей красоты.. на скорую руку набросал.. лениво мне)

procedure change(var a, b: integer);
var tmp : integer;
begin
tmp :=a; a:=b; b:=tmp;
end;

procedure SheikerSort(var A: array of integer; var N: integer; var S, P: integer);
{...}

var 
 A : array[0..19] of integer;
 i, S, P, N: integer;
begin
randomize;
S:= 0; P:=0;
 for i:=19 downto 0 do 
	A[i]:= random(41);
	for i:=0 to 19 do write(A[i],'   ');
	writeln;
N:=19;
SheikerSort(A, N, S, P);
for i:=0 to 19 do write(A[i],'   ');
readln;
end.

Upd. Вообще есть идея, в чем у Вас ошибка. Покажите весь код - скажу.

[leshij]

вот полный код, там правда дофига других ещё методов...

program Project_1;

{$APPTYPE CONSOLE}

uses
 SysUtils;

procedure change(var x,y: integer);
var
  b: integer;
begin
  b:= x;
  x:= y;
  y:= b;
end;

procedure ReadArray(FileName:string; var A:array of integer; var N:integer);
var
 f: text;
begin
 N:= 0;
 AssignFile(f, FileName);
 Reset(f);
 while not eof(f) do
 begin
   readln(f, A[N]);
   N:= N+1;
 end;
 CloseFile(f);
end;

procedure SimpleExchange(var A: array of integer; var N: integer;
                         var S, P: integer);
var
 i, j, b: integer;
begin
 P:= 0; S:= 0;
 for i:= 0 to N-2 do
 begin
   for j:= 0 to N-2 do
   begin
     inc(S);
     if A[j] > A[j+1] then change(A[j], A[j+1]);
     inc(P);
   end;
 end;
end;

procedure SimpleSelection(var A: array of integer; var N: integer; var
S, P: integer);
var
 j, i,k, min: integer;
begin
  S:= 0; P:= 0;
  for i:= 0 to N-2 do
  begin
    k:= i;
    min:= a[i];
    inc(S);
    for j:= i to N-1 do
    if a[j]< min then
    begin
      min:= A[j];
      k:= j;
    end;
    a[k]:= a[i];
    a[i]:= min;
    inc(P);
  end;
end;

procedure SimpleInsertion(var A: array of integer; var N: integer; var
S, P: integer);
var
 j, i, b: integer;
begin
 P:= 0;  S:= 0;
 for i:= 1 to N-1 do
 begin
   for j:=i downto 1 do
   begin
     inc(S);
     if A[j] < A[j-1] then
     begin
       change(a[j], a[j-1]);
       inc(P);
     end
     else break;
   end;
 end;
end;

procedure HeapStep(var A: array of integer; N,i:integer; var S,P: integer);
var
  k: integer;
begin
  if (2*i+1)>=N then exit;
  if (2*i+2)>=N then k:= 2*i+1
  else
  begin
    inc(S);
    if A[2*i+1]> A[2*i+2] then k:= 2*i+1
    else k:= 2*i+2;
  end;
  inc(S);
  if A[i]<A[k] then
  begin
    inc(P);
    change(A[i],A[k]);
    HeapStep(A,N,S,P,K);
  end;
end;

procedure HeapSort(var A: array of integer; var N: integer; var S, P: integer);
var
  i: integer;
begin
  for i:= N div 2 downto 0 do HeapStep(A,N,S,P,i);
  for i:= N-1 downto 1 do
  begin
    inc(P);
    change(A[0], A[i]);
    HeapStep(A,i,0,S,P);
  end;
end;

procedure SheikerSort(var A: array of integer; var N: integer; var S, P: integer);
var
  i,j,l, min, max: integer;
begin
  for i:=0 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 do
    if A[j]>A[max] then max:= j
    else if A[j]<A[min] then min:=j;
    inc(P);
    change(A[i], A[min]);
    if max=i then max:= min;
    inc(P);
    change(A[N-i], A[max]);
  end;
end;

procedure ShellSort(var A: array of integer; var N: integer; var S, P: integer);
var
  i,b,h,j:integer;
begin
  b:= N-1;
  h:= b div 2;
  while h>=1 do
  begin
    for i:= 0 to b-h do
    begin
      j:= i;
      inc(S);
      while (A[j]> A[j+h]) do
      begin
        change(A[j],A[j+h]);
        inc(P);
        dec(j);
      end;
    end;
    h:= h div 2;
  end;
end;

procedure sort(var A: array of integer; l,r: integer; var S,P:integer);
var
  i,j,x: integer;
begin
  i:= l;
  j:= r;
  x:= a[(i+j) div 2];
  repeat
    while a[i]<x do inc(i);
    while a[j]>x do dec(j);
    inc(S);
    if j>=i then
    begin
      inc(P);
      change(a[i], a[j]);
      inc(i);
      dec(j);
    end;
  until i>j;
  inc(S);
  if l<j then sort(A,l,j,S,P);
  inc(S);
  if i<r then sort(A,i,r,S,P);
end;

procedure QuickSort(var A: array of integer; var N: integer; var S, P: integer);
begin
  sort(A,0, N-1,S,P);
end;



procedure WriteArray(FileName: string; var A: array of integer; N: integer);
var
 f: text;
 i: integer;
begin
 assignFile(f, FileName);
 rewrite(f);
 for i:= 0 to N-1 do
 begin
   writeln(f, A[i]);
 end;
 closefile(f);
end;

var
 B: array[0..10000] of integer;
 N: integer;
 S,P: integer;
 q: integer;
begin
  ReadArray('task.txt', B, N);

  writeln('1 - simpleexchange; 2 - simpleselection; 3 - simpleinsertion; 4-piramida; 5-sheikersort; 6-shellsort; 7-quicksort');
  readln(q);

  case q of
    1:  SimpleExchange(B, N, S, P);
    2:  SimpleSelection(B, N, S, P);
    3:  SimpleInsertion(B, N, S, P);
    4:  HeapSort(B,N,S,P);
    5:  SheikerSort(B,N,S,P);
    6:  ShellSort(B,N,S,P);
    7:  QuickSort(B,N,S,P);
  end;
  writeln('izpildito salidzinajumu skaits = ', S);
  writeln('izpildito parvietojumu skaits = ', P);

  WriteArray('ok.txt', B, N);
  readln;
end.

[__STDC__]

Предположу, что проблема вот здесь

procedure ReadArray(FileName:string; var A:array of integer; var N:integer);
...
 while not eof(f) do
 begin
   readln(f, A[N]);
   N:= N+1;
...

У Вас при таком способе ввода массива и индексации от нуля будет лишний элемент в массиве.. т.е. попробуйте индексировать массив с 1, например.. так удобней.. или попробуйте в самой сортировке вместо N писать N-1...
Это так, навскидку.. я проверить, к сожалению не могу. Если не поможет - отпишите. Да и если поможет пишите тоже..

[leshij]

увы к сожалению не помогает всеровно...тогда совсем перемешивает цыфры...

[__STDC__]

Сообщение от leshij

увы к сожалению не помогает всеровно...тогда совсем перемешивает цыфры...

что именно не помогает? изменение индексации? Если поменять индекс первого эл-та, то его нужно не забыть и во всех for и прочих конструкциях поменять с нуля на единицу

[leshij]

ой дурья голова, тока вначале поменял, да, если поменять индекс то не обнуляет...но оказывается сам метод сортировки не правильный..так как один элемент не на своём месте оказывается ((((

[__STDC__]

Сообщение от leshij

ой дурья голова, тока вначале поменял, да, если поменять индекс то не обнуляет...но оказывается сам метод сортировки не правильный..так как один элемент не на своём месте оказывается ((((

какой из элементов? У меня Ваша процедура с добавлением моего кода (см. выше) все нормально сортирует..

[leshij]

там всё на удивление от массива зависит..один массив сортирует как надо всё правльно...а 2 других не правильно...в одном случаи первый элемент оказывается не на своём месте...а в другом случаи последний закидывается нетуда...

Ваша процедура немножко не понятна...

[__STDC__]

да мой код - это порождение ленивого разума, не обращайте внимания)) После некоторых тестов оказалось, что у меня на нечетном кол-ве элементов тоже сортирует неправильно.. попробуйте в процедуре сортировки в первом цикле написать как-то так

for i:=0 to (N-1) div 2 do

после этого вроде норм.