programAnaliz_sortirovok;{Программа выполняет сортировку массивов разными способами}
usesGraphAbc,timers,ABCobjects;
Type
Ar = array ofinteger;
Var
Order, Revers, Arandom, Q: Ar;
Qsrav, Ssrav, Psrav, Qper, Pper, Sper, N, y, i: integer;
Qtimest, Stimest, Ptimest: string;
Qtime, Stime, Ptime: real;
gisto: boolean;
procedureBuildAr;{Заполняет 3 массива с заданными условиями}
Var
i: integer;
Begin
fori := 0 toN - 1 do
Begin
Order[i] := i;
Revers[i] := N - i;
Arandom[i] := Random(N);
end;
end;
procedureswap(varx, y, z: integer);{Меняем местами заданные элементы массива}
Var
t: integer;
Begin
t := x;
x := y;
y := t;
inc(z);
end;
procedureFindMin(startindex: integer; M: ar; varlowindex: integer);{Перебирает массив начиная с заданного индекса и находим минимальный элемент}
Var
min, u: integer;
Begin
lowindex := startindex;
min := M[startindex];
foru := startindex + 1 toN - 1 do
Begin
inc(Psrav);
ifM[u] < min then
Begin
min := M[u];
lowindex := u;
end;
end;
end;
procedurePryamoi_vibor(M: Ar);{Сортирует массив с помощью прямого выбора}
Var
j: integer;
Begin
forj := 0 toN - 1 do
Begin
FindMin(j, m, i);
swap(M[j], M[i], Pper);
End
end;
procedureShaker(M: Ar);{Сортирует массив методом смешивания}
Var
j, k, l, r: integer;
Begin
L := 2;
R := N - 1;
k := R;
Repeat
Begin
forj := r downtol - 1 do
Begin
ifM[j - 1] > M[j] then
Begin
swap(M[j], M[j - 1], Sper);
k := j;
end;
inc(Ssrav);
end;
L := k + 1;
forj := l tor do
Begin
ifM[j - 1] > M[j] then
Begin
swap(M[j], M[j - 1], Sper);
k := j;
end;
inc(Ssrav);
end;
r := k - 1;
end;
untilL > R;
end;
procedureQsort(l, r: integer);{Сортирует массив Быстрой сортировкой}
Var
i, j, w: integer;
Begin
i := l; j := r;
w := Q[(l + r) div2];
Repeat
while(Q[i] < w) do begininc(i); inc(Qsrav); end;
while(w < Q[j]) do begindec(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) thenqSort(l, j);
if(i < r) thenqSort(i, r);
end;
procedureQtimer;{засекает время выполнения быстрой сортировки}
Begin
Qtime := Qtime + 1;
end;
procedureStimer;{засекает время выполнения шейкерной сортировки}
Begin
Stime := Stime + 1;
end;
procedurePtimer;{засекает время выполнения сортировки прямым выбором}
Begin
Ptime := Ptime + 1;
end;
procedureGist;{Строит гистрограмму одного массива}
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;
ifx < Pper thenx := Pper;
ifx < Sper thenx := 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;
ifx < Psrav thenx := Psrav;
ifx < Ssrav thenx := 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;
ifx < Ptime thenx := Ptime;
ifx < Stime thenx := 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;
procedureTabl;{Строит таблицу одного массива}
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;
procedureResult(l: integer);{Организует построение массивов и их сортировку и вывод с помощью процедур}
Var
i: integer;
Var
qt := newTimer(1, Qtimer);
Var
pt := newTimer(1, Ptimer);
Var
st := newTimer(1, Stimer);
Begin
N := l;
Textout(5, y, 'Итоги сортировки массива в');
Textout(220, y, inttostr(l));
Textout(265, y, ' значений');
SetLength(Order, l);
SetLength(Revers, l);
SetLength(Arandom, l);
Buildar;
Qtime := 0;
qt.start;
ifl = 30000 then
Begin
fori := 1 to10 do
Begin
Q := Copy(Arandom);
Qsort(0, l - 1);
end;
qt.stop;
Qtime := Qtime / 10;
Qsrav := round(Qsrav / 10);
Qper := round(Qper / 10);
End
Else
Begin
fori := 1 to2000 do
Begin
Q := Copy(Arandom);
Qsort(0, l - 1);
end;
qt.stop;
Qtime := Qtime / 2000;
Qsrav := round(Qsrav / 2000);
Qper := round(Qper / 2000);
end;
Ptime := 0;
Q := Copy(Arandom);
pt.start;
ifl = 100 then
Begin
fori := 1 to1000 do
Begin
Q := Copy(Arandom);
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(Arandom);
st.start;
ifl = 100 then
Begin
fori := 1 to2000 do
Begin
Q := Copy(Arandom);
Shaker(Q);
end;
st.stop;
Stime := Stime / 2000;
Ssrav := round(Ssrav / 2000);
Sper := round(Sper / 2000);
End
Else
Shaker(Q);
st.stop;
Textout(5, 30, 'Случайно заполненный массив');
ifgisto = false then
Tabl
Else
Gist;
y := y + 180;
Qsrav := 0;
Qper := 0;
Ssrav := 0;
Sper := 0;
Psrav := 0;
Pper := 0;
Qtime := 0;
qt.start;
ifl = 30000 then
Begin
fori := 1 to10 do
Begin
Q := Copy(Revers);
Qsort(0, l - 1);
end;
qt.stop;
Qtime := Qtime / 10;
Qsrav := round(Qsrav / 10);
Qper := round(Qper / 10);
End
Else
Begin
fori := 1 to2000 do
Begin
Q := Copy(Revers);
Qsort(0, l - 1);
end;
qt.stop;
Qtime := Qtime / 2000;
Qsrav := round(Qsrav / 2000);
Qper := round(Qper / 2000);
end;
Ptime := 0;
Q := Copy(Revers);
pt.start;
ifl = 100 then
Begin
fori := 1 to1000 do
Begin
Q := Copy(Revers);
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(Revers);
st.start;
ifl = 100 then
Begin
fori := 1 to2000 do
Begin
Q := Copy(Revers);
Shaker(Q);
end;
st.stop;
Stime := Stime / 2000;
Ssrav := round(Ssrav / 2000);
Sper := round(Sper / 2000);
End
Else
Shaker(Q);
st.stop;
Textout(5, 215, 'Обратно упорядоченный массив');
ifgisto = false then
Tabl
Else
Gist;
y := y + 180;
Qsrav := 0;
Qper := 0;
Ssrav := 0;
Sper := 0;
Psrav := 0;
Pper := 0;
Qtime := 0;
qt.start;
ifl = 30000 then
Begin
fori := 1 to10 do
Begin
Q := Copy(Order);
Qsort(0, l - 1);
end;
qt.stop;
Qtime := Qtime / 10;
Qsrav := round(Qsrav / 10);
Qper := round(Qper / 10);
End
Else
Begin
fori := 1 to2000 do
Begin
Q := Copy(Order);
Qsort(0, l - 1);
end;
qt.stop;
Qtime := Qtime / 2000;
Qsrav := round(Qsrav / 2000);
Qper := round(Qper / 2000);
end;
Ptime := 0;
Q := Copy(Order);
pt.start;
ifl = 100 then
Begin
fori := 1 to1000 do
Begin
Q := Copy(Order);
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(Order);
st.start;
fori := 1 to10000 do
Begin
Q := Copy(Order);
Shaker(Q);
end;
st.stop;
Stime := Stime / 10000;
Ssrav := round(Ssrav / 10000);
Sper := round(Sper / 10000);
Textout(5, 395, 'Упорядоченный массив');
ifgisto = false then
Tabl
Else
Gist;
end;
proceduremenu(key: integer);{Обрабатывает команды с клавиатуры}
Begin
caseKey of
97: beginClearwindow(clmoneygreen); y := 5; gisto := false; Result(100); end;
98: beginClearwindow(clmoneygreen); y := 5; gisto := false; Result(5000); end;
99: beginClearwindow(clmoneygreen); y := 5; gisto := false; Result(30000); end;
100: beginClearwindow(clmoneygreen); y := 5; gisto := true; Result(100); end;
101: beginClearwindow(clmoneygreen); y := 5; gisto := true; Result(5000); end;
102: beginClearwindow(clmoneygreen); y := 5; gisto := true; Result(30000); end;
103: Closewindow;
end;
end;
procedureinitialize;{Инициализирует графическое окно, и выполняет начальную настройку}
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);
onKeydown := menu;
end;
Begin
initialize;
Result(100);
end.