Добавил:
korayakov
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:SALAST / SORTALLU
.PAS{ Лабораторная работа по АиСД }
{Александра Циммермана }
{Суть - реализация алгоритма сортировки }
{ методом СЛИЯНИЯ & СЛИЯНИЯ-подобных }
{ Typed at 20.09.1996 }
Unit SortAllU;
Interface
Uses WObjects,WinTypes;
{$D CopyRight '96 by A.Tsimmerman}
{$I SortAll.inc}
Type
{Основа - оконное приложение}
PWin = ^TWin;
TWin = object(TWindow)
{object privacy}
Constructor Init(AParent : PWindowsObject;AName : PChar);
Procedure SetUpWindow;
Virtual;
Procedure MaySort(May : Boolean);
Function CanClose : Boolean;
Virtual;
Procedure GetWindowClass(Var AWndClass : TWndClass);
Virtual;
Function GetClassName : PChar;
Virtual;
Procedure cmAbout (Var Msg : TMessage);
Virtual cm_First + cm_AuthorHelp;
Procedure cmPicture (Var Msg : TMessage);
Virtual cm_First + cm_Picture;
Procedure cmSound (Var Msg : TMessage);
Virtual cm_First + cm_Sound;
Procedure cmHowUse (Var Msg : TMessage);
Virtual cm_First + cm_HowUse;
Procedure cmArrayParams (Var Msg : TMessage);
Virtual cm_First + cm_ArrayParams;
Procedure cmCommonHelp (Var Msg : TMessage);
Virtual cm_First + cm_CommonHelp;
Procedure cmThanxHelp (Var Msg : TMessage);
Virtual cm_First + cm_ThanxHelp;
Procedure cmArrayCreate (Var Msg : TMessage);
Virtual cm_First + cm_ArrayCreate;
Procedure cmArrayShow (Var Msg : TMessage);
Virtual cm_First + cm_ArrayShow;
Procedure cmSortParams (Var Msg : TMessage);
Virtual cm_First + cm_SortParams;
Procedure cmMyExit (Var Msg : TMessage);
Virtual cm_First + cm_MyExit;
Procedure Paint ( pDC : hDC; Var PS : TPaintStruct);
Virtual;
Procedure Ground ( pDC : hDC);
Procedure cmShowResult (Var Msg : TMessage);
Virtual cm_First + cm_ShowResult;
Procedure cmMethodsInfo (Var Msg : TMessage);
Virtual cm_First + cm_MethodsInfo;
Procedure UpDateResult;
Virtual;
Function AreParamsOK : Boolean;
Procedure cmPoints (Var Msg : TMessage);
Virtual cm_First + cm_Points;
Procedure cmGraphic (Var Msg : TMessage);
Virtual cm_First + cm_Graphic;
Destructor Done; Virtual;
End; {TWin-obejct}
Implementation
Uses WinCRT,WinProcs,Strings,TimeUnit,Commons,Dialogi;
{--------------TWin----Methods realization}
Constructor TWin.Init(AParent : PWindowsObject;AName : PChar);
Var PSt : PStatic;
i : Integer;
Begin
{interface}
TWindow.Init(AParent,AName);
Attr.Menu := LoadMenu(hInstance,AppName);
Attr.W:= 350; Attr.H := 200;
Attr.X := 50; Attr.Y := 50;
Attr.Style := ws_MinimizeBox;
StrCopy(WindowTitle,'Просмотр массива');
StrCopy(InactiveTitle,WindowTitle);
CheckBreak := False;
ScreenSize.X := 60;
ScreenSize.Y := 600;
StrPCopy(Params.Value,'1000');
StrPCopy(Params.Length,'1000');
SP.Direct := 1;
SP.Reverse := 0;
SP.SaveIt := bf_Checked;
New(Params.Col,Init(MassiwTypes,1));
Params.Sel := 0;
For i := 1 To MassiwTypes Do
Params.Col^.Insert(ElMas[i]);
New(Params.Col2,Init(MassiwTypes1,1));
Params.Sel2 := 0 ;
For i := 1 To MassiwTypes1 Do
Params.Col2^.Insert(ElDiap[i]);
New(MInfo.Col,Init(SortNum,1));
MInfo.Sel := 0;
For i := 0 To SortNum Do
MInfo.Col^.Insert(SortName[i]);
MaySort(False);
HasBMP := True;
HasSound := True;
If Not HasSound Then EnableMenuItem(Attr.Menu,cm_Sound,mf_Grayed)
Else ModifyMenu(Attr.Menu,cm_Sound,mf_Enabled,cm_Sound,'Выключить звуки');
EnableMenuItem(Attr.Menu,320,mf_Grayed);
New(Graphic,Init(50,1));
SortCurrent := 0;
End;
Procedure TWin.SetUpWindow;
Begin
GetMem(Massiw,MaxNum*2);
If Massiw = NIL Then
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
MessageBox(hWindow,'Не хватает памяти','Выход из программы',mb_OK Or mb_IconExclamation);
Done;
End;
GetMem(Field,MaxNum*2);
If Field = NIL Then
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
MessageBox(hWindow,'Не хватает памяти','Выход из программы',mb_OK Or mb_IconExclamation);
FreeMem(Massiw,MaxNum*2);
Done;
End;
End;
Procedure TWin.MaySort(May : Boolean);
Var i,Stat : Word;
Begin
If May Then Stat := mf_Enabled Else Stat := mf_Grayed;
For i := 301 To 301+ SortNum-1 Do EnableMenuItem(Attr.Menu,i,Stat);
EnableMenuItem(Attr.Menu,203,Stat);
End;
(**) Procedure TWin.GetWindowClass(Var AWndClass : TWndClass);
Begin
TWindow.GetWindowClass(AWndClass);
AWndClass.hIcon := LoadIcon(hInstance,AppName);
AWndClass.hbrBackGround := GetStockObject(White_Brush);
End;
Function TWin.CanClose;
Begin
CanClose := False;
End;
(**) Function TWin.GetClassName;
Begin
GetClassName := AppName;
End;
(**) Procedure TWin.cmAbout (Var Msg : TMessage);
Var P : PDialog;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'About'));
Application^.ExecDialog(P);
End;
(**) Procedure TWin.cmPicture (Var Msg : TMessage);
Var R : TRect;
Begin
HasBMP := Not HasBMP;
If HasBMP Then ModifyMenu(Attr.Menu,cm_Picture,mf_Enabled,cm_Picture,'Убрать картинку')
Else ModifyMenu(Attr.Menu,cm_Picture,mf_Enabled,cm_Picture,'Включить картинку');
GetClientRect(hWindow,R);
InvalidateRect(hWindow,@R,True);
End;
(**) Procedure TWin.cmSound (Var Msg : TMessage);
Begin
HasSound := Not HasSound;
If HasSound Then ModifyMenu(Attr.Menu,cm_Sound,mf_Enabled,cm_Sound,'Выключить звуки')
Else ModifyMenu(Attr.Menu,cm_Sound,mf_Enabled,cm_Sound,'Включить звуки')
End;
(**) Procedure TWin.cmCommonHelp (Var Msg : TMessage);
Var P : PDialog;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Common'));
Application^.ExecDialog(P);
End;
(**) Procedure TWin.cmThanxHelp (Var Msg : TMessage);
Var P : PDialog;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Thanx'));
Application^.ExecDialog(P);
End;
(*я*) Procedure TWin.cmHowUse (Var Msg : TMessage);
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
InitWinCRT;
WriteLn(#13#10' ***********Как пользоваться программой************'#13#10);
WriteLn('Лабораторная работа:');
WriteLn(' ТЕСТИРОВАНИЕ РАЗЛИЧНЫХ');
WriteLn(' МЕТОДОВ СОРТИРОВКИ(МС) ЛИНЕЙНЫХ МАССИВОВ'#13#10);
WriteLn('Цель:');
WriteLn(' 1.Определить теоретическую сложность(ТС) различ-');
WriteLn(' ных МС для различных типов массивов');
WriteLn(' 2.Разбить данные МС на группы по');
WriteLn(' а) ТС');
WriteLn(' б) лучшим массивам для прямой сортировки');
WriteLn(' б) худшим массивам для прямой сортировки');
WriteLn(' 3.Построить графики t=t(n) для групп МС по ТС'#13#10);
WriteLn('Ход работы:');
WriteLn(' 1.В диалоговом окне (ДО) " Информация о методах"');
WriteLn(' (клавиша F7) выберите МС и в рекомендуемом диа-');
WriteLn(' пазоне выберите 5-7 точек для тестирования.');
WriteLn(' В ДО "Параметры сортировки"(клавиша F5) устано-');
WriteLn(' вите занесение результата в список для графика.');
WriteLn(' Для выбранных точек повторите действия:');
WriteLn(' - в ДО "Параметры массива"(клавиша F2) задайте');
WriteLn(' длину массива(диапазон элементов не изменять)');
WriteLn(' - установите самый общий тип массива:');
WriteLn(' Элементы массива - могут быть совпадающие');
WriteLn(' и распределены равномерно по диапазону. ');
WriteLn(' - нажмите F3 для создания массива');
WriteLn(' - вызовите из меню требуемую сортировку.');
WriteLn(' - по желанию проверьте массив (просмотр клави-');
WriteLn(' шей F4');
WriteLn(' В ДО "Результаты для графика"(клавиша F8) обра-');
WriteLn(' ботайте результаты (удалите нехарактерные точки');
WriteLn(' с t=0.00 или n<100, и точки от других МС).');
WriteLn(' В ДО "Просмотр графика"(клавиша F9) установите');
WriteLn(' прорисовку графиков опорных ТС.Изменяя масштаб');
WriteLn(' оси n , найдите ТС , на график которой наиболее');
WriteLn(' точно попадают результаты.Найденная ТС является');
WriteLn(' ТС тестируемого МС для заданного типа массива.');
WriteLn(' Зарисуйте полученный график.');
WriteLn(' Проделайте все эти действия для остальных МС.'#13#10);
WriteLn(' 2.Протестируйте методы для различных типов масси-');
WriteLn(' вов.Проследите,не меняется ли ТС МС и какие ти-');
WriteLn(' пы массивов являются лучшими, а какие - худшими');
WriteLn(' для МС.В частности:');
WriteLn(' -убедитесь,что быстрая сортировка Хоара имеет');
WriteLn(' ТС n*Log2(n) для общего случая, но ТС n^2 для');
WriteLn(' упорядоченного массива или для массива одина-');
WriteLn(' ковых элементов.');
WriteLn(' -определите,какие МС используют признак Айвер-');
WriteLn(' сона при сортировке упорядоченного массива');
WriteLn(' (время сортировки ~0.00)');
WriteLn(' -определите, до какой длины массива сортировка');
WriteLn(' МС с ТС n^2 занимает меньше времени, чем МС с');
WriteLn(' ТС n*Log2(n).'#13#10);
WriteLn(' -определите, для каких МС benchmark #1 является');
WriteLn(' "ловушкой",а для каких- основой для более быс-');
WriteLn(' строй сортировки.'#13#10);
WriteLn('-----------------------------------------------------');
WriteLn(' О benchmark #2:');
WriteLn(' Разупорядоченность M массива A вычисляется по ');
WriteLn(' формуле:');
WriteLn(' i=_n ');
WriteLn(' \ Abs(i-R(Ai)) ');
WriteLn(' M = / ---------------- , где');
WriteLn(' /_ n');
WriteLn(' i= 1');
WriteLn(' R(Ai) - позиция элемента, которой стоит в данный');
WriteLn(' момент на i-м месте, в массиве после сортировки.');
WriteLn(' Наименьшая разупорядоченность - у уже отсортиро-');
WriteLn(' ванного массива: Mmin = 0');
WriteLn(' Наибольшая -у противоположно сортированного мас-');
WriteLn(' сива: Mmax = [n/2]');
WriteLn(' Генератор позволяет создать массивы с заданной');
WriteLn(' величиной разупорядоченности. Эти величины зада-');
WriteLn(' ются в графе "Элементы по диапазону" (клавиша F2)');
End;
(**) Procedure TWin.cmArrayParams (Var Msg : TMessage);
Var P : PParamsDialog;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Params'));
P^.TransferBuffer := @Params;
If Application^.ExecDialog(P) = id_OK Then MaySort(False);
AreParamsOK;
End;
Procedure TWin.cmArrayCreate (Var Msg : TMessage);
Var W,El,_Ot,_Do,i,Kol : Word;
Can : Boolean;
hC,oC : hCursor;
RK : Real;
Middle : Word;
M : Word;
Temp : Word;
Begin
If Not AreParamsOK Then Exit;
HasMassiw := False;
MaySort(False);
_Ot := Round(0.45*Params.ValueW);
_Do := Round(0.10*Params.ValueW);
Case Params.Sel Of
2: {все одинаковые}
Case Params.Sel2 Of
1:
Begin
El := (_Ot + Random(_Do) Mod Params.ValueW);
For W := 1 To Params.LengthW Do
Massiw^[W] := El;
End;
0:
Begin
El := Random(Params.ValueW);
For W := 1 To Params.LengthW Do
Massiw^[W] := El;
End;
End;{Of Sel2}
1: {все разные}
Begin
If Params.ValueW < Params.LengthW Then
Begin
MessageBox(hWindow,'Невозможные условия','Проверьте параметры массива!',mb_IconStop);
Exit;
End;
If (Params.LengthW>2000) And (Params.ValueW/Params.LengthW<=2) Then
If MessageBox(hWindow,'!!!!Создание массива может занять МНОГО времени!!!!','Продолжать все равно ??',
mb_YesNo Or mb_IconExclamation) = id_No Then Exit;
hC := LoadCursor(0,idc_Wait);
oC := SetCursor(hC);
Case Params.Sel2 Of
1:
Begin
_Ot := Abs(Round((Params.ValueW-Params.LengthW) Div 2));
If _Ot + Params.LengthW > Params.ValueW Then
Begin
MessageBox(hWindow,'Не могу создать такой массив','Извините!',mb_IconStop);
Exit;
End;
FillChar(Field^,MaxNum*2,$FF);
Kol := 0;
While Kol < Params.LengthW Do
Begin
Can := True;
El := _Ot + Random(Params.LengthW);
i := 1;
While (i<=Kol) And (Can) Do
Begin
If El=Field^[i] Then Can := False;
Inc(i);
End;
If Can Then
Begin
Inc(Kol);
Massiw^[Kol] := El;
Field^[Kol] := El;
End;
End;
End;
0:
Begin
FillChar(Field^,MaxNum*2,$FF);
Kol := 0;
While Kol < Params.LengthW Do
Begin
Can := True;
El := Random(Params.ValueW);
i := 1;
While (i<=Kol) And (Can) Do
Begin
If El=Field^[i] Then Can := False;
Inc(i);
End;
If Can Then
Begin
Inc(Kol);
Massiw^[Kol] := El;
Field^[Kol] := El;
End;
End;
End;
End;{Of Sel2}
SetCursor(oC);
DeleteObject(hC);
End;
0: {могут быть одинаковые}
Case Params.Sel2 Of
1:
For W := 1 To Params.LengthW Do
Massiw^[W] := (_Ot + Random(_Do) Mod Params.ValueW);
0:
For W := 1 To Params.LengthW Do
Massiw^[W] := Random(Params.ValueW);
End;{Of Sel2}
3:
Begin
RK := Params.ValueW/Params.LengthW;
Middle := Round(Params.LengthW/2);
For W := 1 To Middle Do
Massiw^[W] := Round (2*W*RK);
For W := Middle +1 To Params.LengthW-1 Do
Begin
Massiw^[W] := Massiw^[W-Middle] +
+ Random(Massiw^[W-Middle+1]- Massiw^[W-Middle])
End;
Massiw^[Params.LengthW] :=Params.ValueW;
End; {Of Case Sel = 3}
4:
Begin
RK := Params.ValueW/Params.LengthW;
For W := 1 To Params.LengthW Do
Massiw^[W] := Round (W*RK);
Case Params.Sel2 Of
2: M := Solution(Params.LengthW,0.10);
3: M := Solution(Params.LengthW,0.25);
4: M := Solution(Params.LengthW,0.50);
5: M := Solution(Params.LengthW,0.75);
6: M := Solution(Params.LengthW,0.90);
End; {Of Case Sel2}
For W := 1 To M Do
Begin
Temp := Massiw^[W];
Massiw^[W] := Massiw^[Params.LengthW-W+1];
Massiw^[Params.LengthW-W+1] := Temp;
End;
End;
End;{Of Sel}
HasMassiw := True;
MaySort(True);
If HasSound Then MessageBeep(mb_IconExclamation);
SortCurrent := 0;
End;
Procedure TWin.cmArrayShow (Var Msg : TMessage);
Var W : Word;
Begin
If Not HasMassiw Then Exit;
If HasSound Then MessageBeep(mb_IconExclamation);
InitWinCRT;
WriteLn(#13#10'++++++++++++++++++++++++++++++++++++++');
WriteLn('Сортировка ':25,SortName[SortCurrent]);
WriteLn('Количество элементов : ':25,Params.Length);
WriteLn('Диапазон : ':25,Params.Value);
WriteLn('Элементы массива : ':25,ElMas[Params.Sel+1]);
WriteLn('Элементы по диапазону: ':25,ElDiap[Params.Sel2+1]);
For W := 1 To Params.LengthW Do
Write(Massiw^[W]:6);
WriteLn(#13#10'______________________________________');
End;
(**) Procedure TWin.cmSortParams (Var Msg : TMessage);
Var P : PSortDialog;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'SortParams'));
P^.TransferBuffer := @SP;
Application^.ExecDialog(P);
End;
Procedure TWin.UpDateResult;
Begin
StrCopy(Result.Method,SortName[SortCurrent]);
StrCopy(Result.StElMas,ElMas[Params.Sel+1]);
StrCopy(Result.StElDiap,ElDiap[Params.Sel2+1]);
StrCopy(Result.Length,Params.Length);
StrCopy(Result.Value,Params.Value);
StrCopy(Result.SortTime,Elapsed);
StrCopy(Result.Direction,DirectionName[SP.Direct]);
End;
(**) Procedure TWin.cmShowResult (Var Msg : TMessage);
Var P : PResultDialog;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Result'));
Application^.ExecDialog(P);
End;
(**) Procedure TWin.cmMethodsInfo (Var Msg : TMessage);
Var P : PMethodsInfoDialog;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'MethodsInfo'));
P^.TransferBuffer := @MInfo;
Application^.ExecDialog(P);
End;
Procedure TWin.cmMyExit (Var Msg : TMessage);
Begin
Done;
(* If HasSound Then MessageBeep(mb_IconExclamation);
If MessageBox(hWindow,'Вы действительно хотите выйти?','Подтверждение',mb_YesNo) = id_Yes Then
MessageBox(hWindow,'Большое спасибо за работу с этой программой','От автора:',0)
Else Exit;
Done;
*)
End;
Procedure TWin.Paint ( pDC : hDC; Var PS : TPaintStruct);
Begin
TWindow.Paint(pDC, PS);
If HasBMP Then Ground(pDC);
End;
Procedure TWin.Ground ( pDC : hDC);
Var oBit,hBit : hBitMap;
BitDC : hDC;
TBit : TBitMap;
Begin
hBit := LoadBitMap(hInstance,AppName);
GetObject (hBit,SizeOf(TBit), @TBit);
BitDC := CreateCompatibleDC (pDC);
oBit := SelectObject(BitDC, hBit);
BitBlt (pDC, -1,0, 350, 200, BitDC, 0, 0, SrcCopy);
SelectObject(BitDC,oBit);
DeleteDC(BitDC);
DeleteObject(hBit);
End;
Function TWin.AreParamsOK : Boolean;
Var St : String;
L : LongInt;
Code: Integer;
Begin
AreParamsOK := False;
Params.LengthW := 0;
St := StrPas(Params.Length);
Val(St,L,Code);
If (Code<>0) Or (L<2) Or (L>30000) Then
Begin
MessageBox(hWindow,'Допустимая длина массива: 2-30000','Проверьте Себя!'
,mb_IconExclamation);
StrCopy(Params.Length,'');
Exit;
End;
Params.LengthW := L;
Params.ValueW := 0;
St := StrPas(Params.Value);
Val(St,L,Code);
If (Code<>0) Or (L<1) Or (L>65000) Then
Begin
MessageBox(hWindow,'Допустимый диапазон: 1-65000','Проверьте Себя!'
,mb_IconExclamation);
StrCopy(Params.Value,'');
Exit;
End;
Params.ValueW := L;
If Params.Sel = 3 Then Params.Sel2 := 0;
If (Params.Sel = 4) And Not (Params.Sel2 IN [2..6]) Then
Begin
MessageBox(hWindow,'Для benchmark #2 необходимо указать разу'+
+'порядоченность в графе "Элементы по диапазону"','Проверьте Себя!'
,mb_IconExclamation);
Exit;
End;
If (Params.Sel2 IN [2..6]) And Not (Params.Sel = 4) Then
Begin
MessageBox(hWindow,'Значение графы "Элементы по диапазону"'+
+'применимо лишь для benchmark #2','Проверьте Себя!'
,mb_IconExclamation);
Exit;
End;
AreParamsOK := True;
End;
(**) Procedure TWin.cmPoints (Var Msg : TMessage);
Var P : PPointsDialog;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Points'));
Application^.ExecDialog(P);
End;
(**) Procedure TWin.cmGraphic (Var Msg : TMessage);
Var P : PGraphicDialog;
Begin
If HasSound Then MessageBeep(mb_IconExclamation);
New(P, Init(@Self, 'Graphic'));
Application^.ExecDialog(P);
End;
Destructor TWin.Done;
Begin
FreeMem(Massiw,MaxNum*SizeOf(Word));
FreeMem(Field,MaxNum*SizeOf(Word));
DoneWinCRT;
TWindow.Done;
End;
Begin
Randomize;
End.
я