Шейкерная сортировка

@xolyspirit · Регистрация: 04.10.2013

Author24 — интернет-сервис помощи студентам

День добрый.
Помогите найти ошибку в коде. Все сделал как в учебнике. Процедура отрабатывает но массив не сортируется.

Pascal

procedure Shaker(M:Ar);{Сортирует массив методом смешивания}
var
j,k,l,r:integer;
begin
L:=1;
R:=N-1;
k:=R;
 
Repeat
begin
for j:=r to l-1 do
begin
 
if M[j-1] > M[j] then
begin
swap(M[j],M[j-1]);
k:=j;
end;
end;
L:=k+1;
 
for j:=l to r+1 do
begin
if M[j-1]> M[j] then
begin
swap(M[j],M[j-1]);
k:=j;
end;
end;
r:=k-1;
end;
until L>R;
end;

@Puporev · 30.04.2016, 16:40

А где начало программы?

@xolyspirit · 30.04.2016, 17:00 **[ТС]**

управление кнопками 1-7 на нумпаде. кнопка 7 выводит массив случайных чисел отсортированный Шейкером.

Pascal

Program Analiz_sortirovok;{Программа выполняет сортировку массивов разными способами}
uses GraphAbc,timers,ABCobjects;
Type
Ar=array of integer;
Var
Arvozr,Arub,Arrandom,Q:Ar;
Qsrav,Ssrav,Psrav,Qper,Pper,Sper,N,y,i:integer;
Qtimest,Stimest,Ptimest:string;
Qtime,Stime,Ptime:real;
gisto:boolean;
 
Procedure BuildAr;{Заполняет 3 массива с максимальной длинной с заданными условиями}
var 
i : integer; 
begin
for i := 0 to N-1 do 
begin
{Arvozr[i] := i;
Arub[i] := N-i;}
Arrandom[i]:=Random(N);
Arvozr[i] :=Random(N);
Arub[i] :=Random(N);
end;
end;
 
procedure swap(var x,y,z: integer);{Меняем местами заданные элементы массива}
var t: integer;
begin
t := x;
x := y;
y := t;
inc(z);
end;
 
procedure FindMin(startindex:integer;M:ar;var lowindex: integer);{Перебирает массив начиная с заданного индекса и находим минимальный элемент}
var min,u:integer;
begin
lowindex:= startindex;
min := M[startindex];
for u:=startindex+1 to N-1 do
begin
inc(Psrav);
if M[u]< min then
begin
min := M[u];
lowindex:= u;
end;
end;
end;
 
procedure Pryamoi_vibor(M:Ar);{Сортирует массив с помощью прямого выбора}
var
j:integer;
begin
for j:=0 to N-1 do
begin 
FindMin(j,m,i);
swap(M[j],M[i],Pper);
end
end;
 
procedure Shaker(M:Ar);{Сортирует массив методом смешивания}
var
j,k,l,r:integer;
begin
L:=1;
R:=N-1;
k:=R;
 
Repeat
begin
for j:=r to l-1 do
begin
inc(Ssrav);
if M[j-1] > M[j] then
begin
swap(M[j],M[j-1],Sper);
k:=j;
end;
end;
L:=k+1;
 
for j:=l to r+1 do
begin
inc(Ssrav);
if M[j-1]> M[j] then
begin
swap(M[j],M[j-1],Sper);
k:=j;
end;
end;
r:=k-1;
end;
until L>R;
end;
 
procedure Qsort(l,r:integer);{Сортирует массив Быстрой сортировкой}
var i,j,w:integer;
begin
  i := l; j := r;
 w := Q[(l+r) div 2];
  repeat
    while (Q[i] < w) do begin inc(i); inc(Qsrav); end;
    while (w < Q[j]) do begin dec(j); inc(Qsrav); end;
    if (i <= j) then
    begin
      swap(Q[i],Q[j],Qper);
      inc(i); dec(j);
    end;
  until (i > j);
  if (l < j) then qSort(l,j);
  if (i < r) then qSort(i,r);
end;
 
Procedure Qtimer;
begin
Qtime:=Qtime+1;
end;
 
Procedure Stimer;
begin
Stime:=Stime+1;
end;
 
Procedure Ptimer;
begin
Ptime:=Ptime+1;
end;
 
Procedure Gist;{Строит гистрограмму одного массива}
var
a,c,b:integer;
x:real;
begin
SetBrushColor(clgreen);
Textout(500,5,'Быстрая');
SetBrushColor(clDarkOrchid);
Textout(600,5,'Прямая');
SetBrushColor(clHotPink);        
Textout(700,5,'Шейкерная');
 
SetBrushColor(clmoneygreen);
Textout(95,a+55,'Перемещений');
Textout(355,a+55,'Сравнений');
Textout(605,a+55,'Время в мсек.');   
  
x:=Qper;
If x<Pper then x:=Pper;
If x<Sper then x:=Sper;
a:=round(90/(x/Qper));
b:=round(90/(x/Pper));
c:=round(90/(x/Sper));
 
SetBrushColor(clgreen);
FillRectangle(10,y+165,70,y+165-a+2);
SetBrushColor(clDarkOrchid);
FillRectangle(100,y+165,160,y+165-b+2);
SetBrushColor(clHotPink);  
FillRectangle(190,y+165,250,y+165-c+2);
 
x:=Qsrav;
If x<Psrav then x:=Psrav;
If x<Ssrav then x:=Ssrav;
a:=round(90/(x/Qsrav));
b:=round(90/(x/Psrav));
c:=round(90/(x/Ssrav));
 
SetBrushColor(clgreen);
FillRectangle(280,y+165,340,y+165-a+2);
SetBrushColor(clDarkOrchid);
FillRectangle(370,y+165,430,y+165-b+2);
SetBrushColor(clHotPink);  
FillRectangle(460,y+165,520,y+165-c+2);
 
x:=Qtime;
If x<Ptime then x:=Ptime;
If x<Stime then x:=Stime;
a:=round(90/(x/Qtime));
b:=round(90/(x/Ptime));
c:=round(90/(x/Stime));
 
SetBrushColor(clgreen);
FillRectangle(550,y+165,610,y+165-a+2);
SetBrushColor(clDarkOrchid);
FillRectangle(640,y+165,700,y+165-b+2);
SetBrushColor(clHotPink);  
FillRectangle(730,y+165,790,y+165-c+2);
 
setpencolor(clblack);
SetBrushColor(clmoneygreen);
 
Textout(10,y+185,inttostr(Qper));
Textout(100,y+185,inttostr(Pper));
Textout(190,y+185,inttostr(Sper));
 
Textout(280,y+185,inttostr(Qsrav));
Textout(370,y+185,inttostr(Psrav));
Textout(460,y+185,inttostr(Ssrav));
 
str(Qtime:8:4,Qtimest);
str(Ptime:8:4,Ptimest);
str(Stime:8:4,Stimest);
Textout(550,y+185,Qtimest);
Textout(640,y+185,Ptimest);
Textout(730,y+185,Stimest);
 
end;
 
Procedure Tabl;{Строит таблицу одного массива}
begin
SetPenWidth(3); 
SetPenColor(clblack); 
Line(2,y+50,788,y+50); 
Line(2,y+170,788,y+170); 
Line(2,y+50,2,y+170); 
Line(788,y+50,788,y+170); 
Line(195,y+50,195,y+170); 
Line(395,y+50,395,y+170); 
Line(595,y+50,595,y+170); 
Line(2,y+85,788,y+85); 
Line(2,y+115,788,y+115); 
Line(2,y+145,788,y+145); 
 
Textout(5,y+60,'  Значения');
Textout(205,y+60,'Быстрая сортировка');
Textout(405,y+60,'Прямая сортировка');
Textout(605,y+60,'Шейкерная сортировка');
Textout(5,y+90,'  Перемещений');
Textout(205,y+90,inttostr(Qper));
Textout(405,y+90,inttostr(Pper));
Textout(605,y+90,inttostr(Sper));
Textout(5,y+120,'  Сравнений');
Textout(205,y+120,inttostr(Qsrav));
Textout(405,y+120,inttostr(Psrav));
Textout(605,y+120,inttostr(Ssrav));
str(Qtime:8:4,Qtimest);
str(Ptime:8:4,Ptimest);
str(Stime:8:4,Stimest);
Textout(5,y+150,'  Время в мсек');
Textout(205,y+150,Qtimest);
Textout(405,y+150,Ptimest);
Textout(605,y+150,Stimest);
end;
 
Procedure Zapusk(N:integer);{Организует построение массивов и их сортировкуи вывод с помощью процедур}
var i:integer;
var qt:=new Timer(1,Qtimer);
var pt:=new Timer(1,Ptimer);
var st:=new Timer(1,Stimer);
 
begin
SetLength(Arvozr,N);
SetLength(Arub,N);
SetLength(Arrandom,N);
Buildar;
 
Qtime:=0;
qt.start;
if N=30000 then
begin
for i:=1 to 10 do
begin
Q:=Copy(Arrandom);
Qsort(0,N-1);
end;
qt.stop;
Qtime:=Qtime/10;
Qsrav:=round(Qsrav/10);
Qper:=round(Qper/10);
end
else
begin
for i:=1 to 2000 do
begin
Q:=Copy(Arrandom);
Qsort(0,N-1);
end;
qt.stop;
Qtime:=Qtime/2000;
Qsrav:=round(Qsrav/2000);
Qper:=round(Qper/2000);
end;
 
Ptime:=0;
Q:=Copy(Arrandom);
pt.start;
if N=100 then
begin
for i:=1 to 1000 do
begin
Q:=Copy(Arrandom);
Pryamoi_vibor(Q);
end;
pt.stop;
Ptime:=Ptime/1000;
Psrav:=round(Psrav/1000);
Pper:=round(Pper/1000);
end
else 
Pryamoi_vibor(Q);
pt.stop;
 
Stime:=0;
Q:=Copy(Arrandom);
st.start;
for i:=1 to 10000 do
begin
Q:=Copy(Arrandom);
Shaker(Q);
end;
st.stop;
Stime:=Stime/10000;
Ssrav:=round(Ssrav/10000);
Sper:=round(Sper/10000);
 
 
 
Textout(5,30,'Случайно заполненный массив');
 
if gisto=false then
Tabl
else
Gist;
y:=y+180;
 
Qsrav:=0;
Qper:=0;
Ssrav:=0;
Sper:=0;
Psrav:=0;
Pper:=0;
 
Qtime:=0;
qt.start;
if N=30000 then
begin
for i:=1 to 10 do
begin
Q:=Copy(Arub);
Qsort(0,N-1);
end;
qt.stop;
Qtime:=Qtime/10;
Qsrav:=round(Qsrav/10);
Qper:=round(Qper/10);
end
else
begin
for i:=1 to 2000 do
begin
Q:=Copy(Arub);
Qsort(0,N-1);
end;
qt.stop;
Qtime:=Qtime/2000;
Qsrav:=round(Qsrav/2000);
Qper:=round(Qper/2000);
end;
 
 
Ptime:=0;
Q:=Copy(Arub);
pt.start;
if N=100 then
begin
for i:=1 to 1000 do
begin
Q:=Copy(Arub);
Pryamoi_vibor(Q);
end;
pt.stop;
Ptime:=Ptime/1000;
Psrav:=round(Psrav/1000);
Pper:=round(Pper/1000);
end
else 
Pryamoi_vibor(Q);
pt.stop;
 
Stime:=0;
Q:=Copy(Arub);
st.start;
 
for i:=1 to 10000 do
begin
Q:=Copy(Arub);
Shaker(Q);
end;
st.stop;
Stime:=Stime/10000;
Ssrav:=round(Ssrav/10000);
Sper:=round(Sper/10000);
 
Textout(5,215,'Обратно упорядоченный массив');
if gisto=false then
Tabl
else
Gist;
y:=y+180;
 
Qsrav:=0;
Qper:=0;
Ssrav:=0;
Sper:=0;
Psrav:=0;
Pper:=0;
 
Qtime:=0;
qt.start;
if N=30000 then
begin
for i:=1 to 10 do
begin
Q:=Copy(Arvozr);
Qsort(0,N-1);
end;
qt.stop;
Qtime:=Qtime/10;
Qsrav:=round(Qsrav/10);
Qper:=round(Qper/10);
end
else
begin
for i:=1 to 2000 do
begin
Q:=Copy(Arvozr);
Qsort(0,N-1);
end;
qt.stop;
Qtime:=Qtime/2000;
Qsrav:=round(Qsrav/2000);
Qper:=round(Qper/2000);
end;
 
 
Ptime:=0;
Q:=Copy(Arvozr);
pt.start;
if N=100 then
begin
for i:=1 to 1000 do
begin
Q:=Copy(Arvozr);
Pryamoi_vibor(Q);
end;
pt.stop;
Ptime:=Ptime/1000;
Psrav:=round(Psrav/1000);
Pper:=round(Pper/1000);
end
else 
Pryamoi_vibor(Q);
pt.stop;
 
Stime:=0;
Q:=Copy(Arvozr);
st.start;
for i:=1 to 10000 do
begin
Q:=Copy(Arvozr);
Shaker(Q);
end;
st.stop;
Stime:=Stime/10000;
Ssrav:=round(Ssrav/10000);
Sper:=round(Sper/10000);
 
 
Textout(5,395,'Упорядоченный массив');
if gisto=false then
Tabl
else
Gist;
end;
 
Procedure Shapka(l:integer);{Заполняет шапку и вывызвает дальнейшую процедуру}
begin
N:=l;
Textout(5,y,'Итоги сортировки массива в');
Textout(220,y,inttostr(N));
Textout(265,y,' значений');
Zapusk(N);
end;
 
 
 
Procedure wind(key:integer);{Обрабатывает команды с клавиатуры}
begin
  case Key of
  97: begin Clearwindow(clmoneygreen); y:=5; gisto:=false; Shapka(100); end;
  98: begin Clearwindow(clmoneygreen); y:=5; gisto:=false; Shapka(5000); end;
  99: begin Clearwindow(clmoneygreen); y:=5; gisto:=false; Shapka(30000); end;
  100: begin Clearwindow(clmoneygreen); y:=5; gisto:=true; Shapka(100); end;
  101: begin Clearwindow(clmoneygreen); y:=5; gisto:=true; Shapka(5000); end;
  102: begin Clearwindow(clmoneygreen); y:=5; gisto:=true; Shapka(30000); end;
    103: begin Clearwindow(clmoneygreen); y:=5; gisto:=false; 
  
  buildar;
  Shaker(q);
  Writeln(q);
end;
 
  end;end;
 
begin
y:=5;
gisto:=false;
SetWindowSize(800,600); 
CenterWindow;
SetbrushColor(clmoneygreen);
FillroundRect(0,0,800,600,1,3);
SetWindowCaption('Анализ сортировок');
SetpenColor(clBlack);
SetpenWidth(2);
setfontsize(12);
Shapka(100);
onKeydown:=wind;
end.

Добавлено через 16 минут

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

procedure Shaker(M:Ar);{Сортирует массив методом смешивания}
var
j,k,l,r:integer;
begin
L:=1;
R:=N-1;
k:=R;

Исправил L:=2;
И все заработало. Не совсем понимаю, почему реальность отличается от учебника

@ChiliPalmer · 02.05.2016, 10:55

xolyspirit, ты вроде работаешь в Абс.НЕТ...
Зачем ты кодишь процедуру Swap, если она и так уже существует(встроенная) и работает?
Зачем писать(кодить) процедуру FindMin, если для массивов существует встроенный метод Min и IndexMin, которые делают тоже самое?

@xolyspirit · 02.05.2016, 22:03 **[ТС]**

Так нагляднее

@ChiliPalmer · 04.05.2016, 14:34

xolyspirit, кстати, по поводу отличий реальности от учебника:
1. Иногда в учебнике тоже бывают ошибки.
2. Иногда алгоритм "не рассчитан" на определенный набор данных(например слишком короткий массив из 2 элементов) или если программист не до конца проверил работу алгоритма при минимальных значениях переменных, которые используются в циклах алгоритма в качестве индексов.
А вообще ошибок и причин может быть много.

@Puporev Почетный модератор 64300 / 47595 / 32743 Регистрация: 18.05.2008 Сообщений: 115,181
	30.04.2016, 16:40	2
	А где начало программы? 1

@ChiliPalmer 20 / 20 / 6 Регистрация: 09.04.2016 Сообщений: 145
	02.05.2016, 10:55	4
	xolyspirit, ты вроде работаешь в Абс.НЕТ... Зачем ты кодишь процедуру Swap, если она и так уже существует(встроенная) и работает? Зачем писать(кодить) процедуру FindMin, если для массивов существует встроенный метод Min и IndexMin, которые делают тоже самое? 0

@xolyspirit 1 / 1 / 1 Регистрация: 04.10.2013 Сообщений: 65
	02.05.2016, 22:03 [ТС]	5
	Так нагляднее 0

@ChiliPalmer 20 / 20 / 6 Регистрация: 09.04.2016 Сообщений: 145
	04.05.2016, 14:34	6
	xolyspirit, кстати, по поводу отличий реальности от учебника: 1. Иногда в учебнике тоже бывают ошибки. 2. Иногда алгоритм "не рассчитан" на определенный набор данных(например слишком короткий массив из 2 элементов) или если программист не до конца проверил работу алгоритма при минимальных значениях переменных, которые используются в циклах алгоритма в качестве индексов. А вообще ошибок и причин может быть много. 0