Guest User

Untitled

a guest
Sep 17th, 2012
85
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 9.34 KB | None | 0 0
  1. unit UnitMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls;
  8.  
  9. type
  10.   TFormMain = class(TForm)
  11.     EditSrc: TEdit;
  12.     btnSort: TButton;
  13.     Label2: TLabel;
  14.     cbSortType: TComboBox;
  15.     btnInitRnd: TButton;
  16.     MemoLog: TMemo;
  17.     btnSortAll: TButton;
  18.     brnPrint: TButton;
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure btnInitRndClick(Sender: TObject);
  21.     procedure btnSortClick(Sender: TObject);
  22.     procedure btnSortAllClick(Sender: TObject);
  23.     procedure FormDestroy(Sender: TObject);
  24.     procedure brnPrintClick(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.   public
  28.     { Public declarations }
  29.   end;
  30.  
  31.   //массив
  32.   TArrayOfInteger = array of Integer;
  33.  
  34. const
  35.   //ограничим генерируемые числа
  36.   cMaxInt = 10000;
  37.  
  38. var
  39.   FormMain: TFormMain;
  40.   //массив
  41.   a: TArrayOfInteger;
  42.  
  43. //инициализация
  44. procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
  45. //вспомогательная функция копирования
  46. function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
  47. //очистка
  48. procedure ArrayClear(a: TArrayOfInteger);
  49. //сортировки
  50. //Метод обмена (Метод пузырька)
  51. procedure BubbleSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
  52. //Метод вставок
  53. procedure InsertSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
  54. //Метод выбора
  55. procedure ChooseSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
  56. //Метод быстрой сортировки
  57. procedure QuickSort(a: TArrayOfInteger; var Cmp, Sw : Integer; Left, Right: Integer; toShow: Boolean = true);
  58. //Cmp - число сравнений
  59. //Sw - число перестановок
  60.  
  61. implementation
  62.  
  63. {$R *.dfm}
  64.  
  65. procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
  66. var
  67.   i: Integer;
  68. begin
  69.   //забиваем массив случайными числами
  70.   ArrayClear(a);
  71.   SetLength(a,N);
  72.   for i:=0 to N-1 do
  73.     a[i]:=Random(cMaxInt);
  74. end;
  75.  
  76. function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
  77. var
  78.   i,N: Integer;
  79. begin
  80.   //копируем массив
  81.   N:=Length(a);
  82.   SetLength(Result,N);
  83.   for i:=0 to N-1 do
  84.     Result[i]:=a[i];
  85. end;
  86.  
  87. procedure ArrayClear(a: TArrayOfInteger);
  88. begin
  89.   SetLength(a,0);
  90. end;
  91.  
  92. procedure BubbleSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
  93. var
  94.   i,j,N,temp: Integer;
  95. begin
  96.   Cmp:=0;
  97.   Sw:=0;
  98.   N:=Length(a);
  99.   for i:=1 to N-1 do
  100.     for j:=N-1 downto i do
  101.       begin
  102.       Inc(Cmp);
  103.       if a[j-1]>a[j] then
  104.         begin
  105.         Inc(Sw);
  106.         temp:=a[j-1];
  107.         a[j-1]:=a[j];
  108.         a[j]:=temp;
  109.         end;
  110.       end;
  111.   //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  112.   if toShow then
  113.     for i:=0 to N-1 do
  114.       FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
  115. end;
  116.  
  117. procedure InsertSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
  118. var
  119.   i,j,N,temp: Integer;
  120. begin
  121.   Cmp:=0;
  122.   Sw:=0;
  123.   N:=Length(a);
  124.   for i:=1 to N-1 do
  125.     begin
  126.     temp:=a[i];
  127.     j:=i-1;
  128.     while (j>=0) and (temp<a[j]) do
  129.       begin
  130.       Inc(Cmp);
  131.       Inc(Sw);
  132.       a[j+1]:=a[j];
  133.       Dec(j);
  134.       end;
  135.     Inc(Cmp);
  136.     a[j+1]:=temp;
  137.     end;
  138.   //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  139.   if toShow then
  140.     for i:=0 to N-1 do
  141.       FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
  142. end;
  143.  
  144. procedure ChooseSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
  145. var
  146.   i,j,k,N,temp: Integer;
  147. begin
  148.   Cmp:=0;
  149.   Sw:=0;
  150.   N:=Length(a);
  151.   for i:=0 to N-2 do
  152.     begin
  153.     k:=i;
  154.     temp:=a[i];
  155.     for j:=i+1 to N-1 do
  156.       begin
  157.       Inc(Cmp);
  158.       if a[j]<temp then
  159.         begin
  160.         k:=j;
  161.         temp:=a[j];
  162.         Inc(Sw);
  163.         end;
  164.       end;
  165.     a[k]:=a[i];
  166.     a[i]:=temp;
  167.     end;
  168.   //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  169.   if toShow then
  170.     for i:=0 to N-1 do
  171.       FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
  172. end;
  173.  
  174. procedure QuickSort(a: TArrayOfInteger; var Cmp, Sw : Integer; Left, Right: Integer; toShow: Boolean);
  175. var
  176.   i,j,sred,temp:integer;
  177. begin
  178.    Cmp:=0;
  179.    Sw:=0;
  180.    i:=left; j:=right; //установка начальных границ подмассива
  181.    sred:=a[(left+right) div 2]; //определение серединного элемента
  182.    repeat
  183.       while (a[i]<sred) do Begin i:=i+1; Inc(Cmp); End; //поиск слева элемента, большего опорного
  184.       while (a[j]>sred) do Begin j:=j-1; Inc(Cmp); End; //поиск справа элемента, меньшего опорного
  185.       if i<=j then
  186.       begin //обмениваем элементы и изменяем индексы
  187.          temp:=a[i]; a[i]:=a[j]; a[j]:=temp;
  188.          i:=i+1; j:=j-1;
  189.          Inc(Sw);
  190.       end;
  191.    until i>j;
  192.    if left<j then QuickSort(a, Cmp, Sw, left, j, toShow); //обработка левой половины
  193.    if i<right then QuickSort(a, Cmp, Sw, i, right, toShow); //обработка правой половины
  194.    //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  195.    if toShow then
  196.       for i:=0 to High(a) do
  197.          FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
  198. end;
  199.  
  200. procedure TFormMain.FormCreate(Sender: TObject);
  201. begin
  202.   ArrayClear(a);
  203. end;
  204.  
  205. procedure TFormMain.btnInitRndClick(Sender: TObject);
  206. var
  207.   i,aCount: Integer;
  208. begin
  209.   try
  210.     aCount:=StrToInt(EditSrc.Text);
  211.     ArrayInitRnd(a,aCount);
  212.     MemoLog.Lines.Clear;
  213.     for i:=0 to aCount-1 do
  214.       MemoLog.Lines.Add(IntToStr(a[i]));
  215.   except
  216.     ShowMessage('Введите целое число');
  217.   end;
  218. end;
  219.  
  220. procedure TFormMain.btnSortClick(Sender: TObject);
  221. var
  222.   Cmp,Sw: Integer;
  223.   b: TArrayOfInteger;
  224. begin
  225.   MemoLog.Lines.Clear;
  226.   //работаем с копией массива, чтобы его не потерять
  227.   b:=ArrayCopy(a);
  228.   case cbSortType.ItemIndex of
  229.   0:
  230.     begin
  231.     MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
  232.     BubbleSort(b,Cmp,Sw);
  233.     MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  234.     MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  235.     MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  236.     end;
  237.   1:
  238.     begin
  239.     MemoLog.Lines.Add('Метод вставок');
  240.     InsertSort(b,Cmp,Sw);
  241.     MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  242.     MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  243.     MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  244.     end;
  245.   2:
  246.     begin
  247.     MemoLog.Lines.Add('Метод выбора');
  248.     ChooseSort(b,Cmp,Sw);
  249.     MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  250.     MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  251.     MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  252.     end;
  253.   3:
  254.     begin
  255.     MemoLog.Lines.Add('Метод быстрой сортировки');
  256.     QuickSort(b,Cmp,Sw,0,High(b),true); //true для того, чтобы видеть печать
  257.     MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  258.     MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  259.     MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  260.     end;
  261.   end;
  262.   SetLength(b,0);
  263. end;
  264.  
  265. procedure TFormMain.btnSortAllClick(Sender: TObject);
  266. var
  267.   Cmp,Sw: Integer;
  268.   b: TArrayOfInteger;
  269. begin
  270.   MemoLog.Lines.Clear;
  271.   //всякий раз работаем с копией массива, чтобы его не потерять
  272.   b:=ArrayCopy(a);
  273.   BubbleSort(b,Cmp,Sw,false);
  274.   MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
  275.   MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  276.   MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  277.   MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  278.   SetLength(b,0);
  279.   b:=ArrayCopy(a);
  280.   InsertSort(b,Cmp,Sw,false);
  281.   MemoLog.Lines.Add('');
  282.   MemoLog.Lines.Add('Метод вставок');
  283.   MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  284.   MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  285.   MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  286.   SetLength(b,0);
  287.   b:=ArrayCopy(a);
  288.   ChooseSort(b,Cmp,Sw,false);
  289.   MemoLog.Lines.Add('');
  290.   MemoLog.Lines.Add('Метод выбора');
  291.   MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  292.   MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  293.   MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  294.   SetLength(b,0);
  295.   b:=ArrayCopy(a);
  296.   QuickSort(b,Cmp,Sw,0,High(b),false);
  297.   MemoLog.Lines.Add('');
  298.   MemoLog.Lines.Add('Метод быстрой сортировки');
  299.   MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  300.   MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  301.   MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  302.   SetLength(b,0);
  303. end;
  304.  
  305. procedure TFormMain.FormDestroy(Sender: TObject);
  306. begin
  307.   ArrayClear(a);
  308. end;
  309.  
  310. procedure TFormMain.brnPrintClick(Sender: TObject);
  311. var
  312.   i: Integer;
  313. begin
  314.   MemoLog.Lines.Clear;
  315.   for i:=0 to Length(a)-1 do
  316.     MemoLog.Lines.Add(IntToStr(a[i]));
  317. end;
  318.  
  319. end.
Advertisement
Add Comment
Please, Sign In to add comment