Guest User

Untitled

a guest
Sep 16th, 2012
81
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 9.25 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, 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, Left, Right: Integer; toShow: Boolean);
  175. var
  176.   i,j,sred,temp,N:integer;
  177. begin
  178.    Cmp:=0;
  179.    Sw:=0;
  180.    N:=Length(a);
  181.    i:=left; j:=right; //установка начальных границ подмассива
  182.    sred:=a[(left+right) div 2]; //определение серединного элемента
  183.    repeat
  184.       while (a[i]<sred) do Begin i:=i+1; Inc(Cmp); End; //поиск слева элемента, большего опорного
  185.       while (a[j]>sred) do Begin j:=j-1; Inc(Cmp); End; //поиск справа элемента, меньшего опорного
  186.       if i<=j then
  187.       begin //обмениваем элементы и изменяем индексы
  188.          temp:=a[i]; a[i]:=a[j]; a[j]:=temp;
  189.          i:=i+1; j:=j-1;
  190.          Inc(Sw);
  191.       end;
  192.    until i>j;
  193.    if left<j then QuickSort(a, Cmp, Sw, left, j, toShow); //обработка левой половины
  194.    if i<right then QuickSort(a, Cmp, Sw, i, right, toShow); //обработка правой половины
  195.    //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
  196.    if toShow then
  197.       for i:=0 to High(a) do
  198.          FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
  199. end;
  200.  
  201. procedure TFormMain.FormCreate(Sender: TObject);
  202. begin
  203.   ArrayClear(a);
  204. end;
  205.  
  206. procedure TFormMain.btnInitRndClick(Sender: TObject);
  207. var
  208.   i,aCount: Integer;
  209. begin
  210.   try
  211.     aCount:=StrToInt(EditSrc.Text);
  212.     ArrayInitRnd(a,aCount);
  213.     MemoLog.Lines.Clear;
  214.     for i:=0 to aCount-1 do
  215.       MemoLog.Lines.Add(IntToStr(a[i]));
  216.   except
  217.     ShowMessage('Введите целое число');
  218.   end;
  219. end;
  220.  
  221. procedure TFormMain.btnSortClick(Sender: TObject);
  222. var
  223.   Cmp,Sw: Integer;
  224.   b: TArrayOfInteger;
  225. begin
  226.   MemoLog.Lines.Clear;
  227.   //работаем с копией массива, чтобы его не потерять
  228.   b:=ArrayCopy(a);
  229.   case cbSortType.ItemIndex of
  230.   0:
  231.     begin
  232.     MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
  233.     BubbleSort(b,Cmp,Sw);
  234.     MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  235.     MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  236.     MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  237.     end;
  238.   1:
  239.     begin
  240.     MemoLog.Lines.Add('Метод вставок');
  241.     InsertSort(b,Cmp,Sw);
  242.     MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  243.     MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  244.     MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  245.     end;
  246.   2:
  247.     begin
  248.     MemoLog.Lines.Add('Метод выбора');
  249.     ChooseSort(b,Cmp,Sw);
  250.     MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  251.     MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  252.     MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  253.     end;
  254.   3:
  255.     begin
  256.     MemoLog.Lines.Add('Метод быстрой сортировки');
  257.     QuickSort(b,Cmp,Sw);
  258.     MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  259.     MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  260.     MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  261.     end;
  262.   end;
  263.   SetLength(b,0);
  264. end;
  265.  
  266. procedure TFormMain.btnSortAllClick(Sender: TObject);
  267. var
  268.   Cmp,Sw: Integer;
  269.   b: TArrayOfInteger;
  270. begin
  271.   MemoLog.Lines.Clear;
  272.   //всякий раз работаем с копией массива, чтобы его не потерять
  273.   b:=ArrayCopy(a);
  274.   BubbleSort(b,Cmp,Sw,false);
  275.   MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
  276.   MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  277.   MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  278.   MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  279.   SetLength(b,0);
  280.   b:=ArrayCopy(a);
  281.   InsertSort(b,Cmp,Sw,false);
  282.   MemoLog.Lines.Add('');
  283.   MemoLog.Lines.Add('Метод вставок');
  284.   MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  285.   MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  286.   MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  287.   SetLength(b,0);
  288.   b:=ArrayCopy(a);
  289.   ChooseSort(b,Cmp,Sw,false);
  290.   MemoLog.Lines.Add('');
  291.   MemoLog.Lines.Add('Метод выбора');
  292.   MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  293.   MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  294.   MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  295.   SetLength(b,0);
  296.   b:=ArrayCopy(a);
  297.   QuickSort(b,Cmp,Sw,false);
  298.   MemoLog.Lines.Add('');
  299.   MemoLog.Lines.Add('Метод быстрой сортировки');
  300.   MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
  301.   MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
  302.   MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
  303.   SetLength(b,0);
  304. end;
  305.  
  306. procedure TFormMain.FormDestroy(Sender: TObject);
  307. begin
  308.   ArrayClear(a);
  309. end;
  310.  
  311. procedure TFormMain.brnPrintClick(Sender: TObject);
  312. var
  313.   i: Integer;
  314. begin
  315.   MemoLog.Lines.Clear;
  316.   for i:=0 to Length(a)-1 do
  317.     MemoLog.Lines.Add(IntToStr(a[i]));
  318. end;
  319.  
  320. end.
Advertisement
Add Comment
Please, Sign In to add comment