1  unit SortingU;
   2   
   3  interface
   4   
   5  uses
   6    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   7    StdCtrls, ExtCtrls, ComCtrls;
   8   
   9  const
  10    NoMax    = 1000;
  11    DataMax  = 600;
  12    PenWidth = 1;
  13  type
  14    TDataNo = 0..NoMax;
  15    TData   = array [TDataNo] of Integer;    // 0番は作業用
  16    TFormSorting = class(TForm)
  17      PanelMain: TPanel;
  18      ButtonClose: TButton;
  19      RadioGroupSort: TRadioGroup;
  20      ButtonNew: TButton;
  21      ButtonExecute: TButton;
  22      PanelHikaku: TPanel;
  23      PanelIdou: TPanel;
  24      PanelJikan: TPanel;
  25      RadioGroupHyouji: TRadioGroup;
  26      PanelBunpu: TPanel;
  27      TrackBarBunpu: TTrackBar;
  28      PanelHani: TPanel;
  29      EditKara: TEdit;
  30      EditMade: TEdit;
  31      procedure ButtonCloseClick(Sender: TObject);
  32      procedure FormCreate(Sender: TObject);
  33      procedure ButtonExecuteClick(Sender: TObject);
  34      procedure ButtonNewClick(Sender: TObject);
  35      procedure RadioGroupSortClick(Sender: TObject);
  36      procedure RadioGroupBunpuClick(Sender: TObject);
  37      procedure TrackBarBunpuChange(Sender: TObject);
  38    private
  39      Data0     : TData;                              // 整列前のデータ
  40      Data      : TData;                              // 整列中のデータ
  41      HikakuSuu : Integer;                            // 比較回数
  42      IdouSuu   : Integer;                            // 移動回数
  43      ByouSuu   : Real;                               // 所要時間
  44      Hyouji    : Boolean;                            // 毎回表示
  45      procedure DrawOne(No : TDataNo);                // No番目のデータを描く
  46      procedure Idou(No1,No2 : TDataNo);              // No1番目をNo2番目に移動する
  47      procedure Koukan(No1,No2 : TDataNo);            // No1番目とNo2番目を交換する
  48      function  Chiisai(No1,No2 : TDataNo) : Boolean; // No1番目がNo2番目より小さい
  49      procedure NewData;                              // 新しいデータを作る
  50      procedure StandBy;                              // 整列の準備をする
  51      procedure BubbleSort0(IMin,IMax : TDataNo);     // 泡整列法（原始版）
  52      procedure BubbleSort(IMin,IMax : TDataNo);      // 泡整列法（改良版）
  53      procedure InsertSort0(IMin,IMax : TDataNo);     // 挿入整列法（原始版）
  54      procedure InsertSort(IMin,IMax : TDataNo);      // 挿入整列法（改良版）
  55      procedure ShellSort(IMin,IMax : TDataNo);       // シェル整列法
  56      procedure QuickSort(IMin,IMax : TDataNo);       // クィックソート
  57    public
  58      { Public 宣言 }
  59    end;
  60   
  61  var
  62    FormSorting: TFormSorting;
  63   
  64  implementation
  65   
  66  {$R *.DFM}
  67  (*********************** フォームのメソッド ********************)
  68  procedure TFormSorting.DrawOne(No : TDataNo);
  69            (* No番目のデータを描く *)
  70  begin
  71    with Canvas do
  72      begin
  73        Pen.Color := clLime;                    // 前のデータを消す
  74        MoveTo(No*PenWidth,DataMax);
  75        LineTo(No*PenWidth,0);
  76        Pen.Color := clAqua;                    // 今のデータを描く
  77        LineTo(No*PenWidth,Data[No]);
  78      end;
  79  end; (* DrawOne *)
  80   
  81  procedure TFormSorting.NewData;
  82            (* 新しいデータを作る *)
  83  var
  84    No : TDataNo;
  85    P  : Real;
  86    R1,R2 : Real;
  87  begin
  88    P := (TrackBarBunpu.Position-3)/3;
  89    for No := 1 to NoMax do
  90      begin
  91        R1 := Random;
  92        R2 := Random;
  93        if P >= 0
  94          then Data0[No] := Trunc(((1-P)*R1+P*R2*No/NoMax)*DataMax)
  95          else Data0[No] := Trunc(((1+P)*R1-P*R2*(NoMax-No)/NoMax)*DataMax);
  96      end;
  97    StandBy;
  98  end; (* NewData *)
  99   
 100  procedure TFormSorting.StandBy;
 101            (* 整列の準備をする *)
 102  var
 103    No : TDataNo;
 104  begin
 105    Data := Data0;                       // 元のデータに初期設定する
 106    for No := 1 to NoMax do              // 全データを描く
 107      DrawOne(No);
 108  end; (* StandBy *)
 109   
 110  procedure TFormSorting.Idou(No1,No2 : TDataNo);
 111            (* No1番目をNo2番目に移動する *)
 112  begin
 113    Data[No2] := Data[No1];
 114    DrawOne(No2);
 115    Inc(IdouSuu);
 116    if Hyouji
 117      then begin
 118             PanelIdou.Caption := Format('移動回数%10d 回',[IdouSuu]);
 119             PanelIdou.Repaint;
 120           end;
 121  end; (* Idou *)
 122   
 123  procedure TFormSorting.Koukan(No1,No2 : TDataNo);
 124            (* No1番目とNo2番目を交換する *)
 125            (* 0番目を退避用に使う        *)
 126  begin
 127    Idou(No1,0);
 128    Idou(No2,No1);
 129    Idou(0,No2);
 130  end; (* Koukan *)
 131   
 132  function  TFormSorting.Chiisai(No1,No2 : TDataNo) : Boolean;
 133            (* No1番目がNo2番目より小さい *)
 134  begin
 135    Chiisai := Data[No1] < Data[No2];
 136    Inc(HikakuSuu);
 137    if Hyouji
 138      then begin
 139             PanelHikaku.Caption := Format('比較回数%10d 回',[HikakuSuu]);
 140             PanelHikaku.Repaint;
 141           end;
 142  end; (* Chiisai *)
 143   
 144  (******************** 整列法 ********************)
 145  procedure TFormSorting.BubbleSort0(IMin,IMax : TDataNo);
 146            (* 泡整列法　(原始版）   *)
 147  var
 148    IEnd,I : TDataNo;
 149  begin
 150    for IEnd := IMax-1 downto IMin do
 151      begin
 152        for I := IMin to IEnd do
 153          if Chiisai(I,I+1)
 154            then Koukan(I,I+1);
 155      end;
 156  end; (* BubbleSort0 *)
 157   
 158  procedure TFormSorting.BubbleSort(IMin,IMax : TDataNo);
 159            (* 泡整列法　(改良版）   *)
 160  var
 161    IEnd,I : TDataNo;
 162    IStart,IFirst,ILast : TDataNo;
 163  begin
 164    IStart := IMin;
 165    IEnd := IMax-1;
 166    repeat
 167      IFirst := IMax;
 168      ILast := IMin;
 169      Idou(IStart,0);
 170      for I := IStart to IEnd do
 171        if Chiisai(0,I+1)
 172          then begin
 173                 Idou(I+1,I);
 174                 ILast := I;
 175                 if I < IFirst
 176                   then IFirst := I;
 177               end
 178          else begin
 179                 Idou(0,I);
 180                 Idou(I+1,0);
 181               end;
 182      Idou(0,IEnd+1);
 183      if IFirst > IMin
 184        then IStart := IFirst-1;
 185      IEnd := ILast-1;
 186    until IStart > IEnd;
 187  end; (* BubbleSort *)
 188   
 189  procedure TFormSorting.InsertSort0(IMin,IMax : TDataNo);
 190            (* 挿入整列法　(原始版）   *)
 191  var
 192    IStart,I : TDataNo;
 193  begin
 194    for IStart := IMin to IMax-1 do
 195      for I := IStart downto IMin do
 196        if Chiisai(I,I+1)
 197          then Koukan(I,I+1);
 198  end; (* InsertSort0 *)
 199   
 200  procedure TFormSorting.InsertSort(IMin,IMax : TDataNo);
 201            (* 挿入整列法　(改良版）   *)
 202  var
 203    IStart,I : TDataNo;
 204  begin
 205    for IStart := IMin to IMax-1 do
 206      begin
 207        Idou(IStart+1,0);
 208        I := IStart;
 209        while (I>=Imin) and Chiisai(I,0) do
 210          begin
 211            Idou(I,I+1);
 212            Dec(I);
 213          end;
 214        Idou(0,I+1);
 215      end;
 216  end; (* InsertSort *)
 217   
 218  procedure TFormSorting.ShellSort(IMin,IMax : TDataNo);
 219            (* シェル整列法 *)
 220  const
 221    Bairitsu = 0.67;
 222  var
 223    IStart,I : TDataNo;
 224    Arasa    : TDataNo;
 225  begin
 226    Arasa := IMax-IMin;
 227    repeat
 228      Arasa := Trunc(Arasa*Bairitsu);
 229      if Arasa < 2
 230        then Arasa := 1;
 231      for IStart := IMin to IMax-Arasa do
 232        begin
 233          I := IStart+Arasa;
 234          while (I > IMin+Arasa) and Chiisai(I-Arasa,I) do
 235            begin
 236              Koukan(I-Arasa,I);
 237              Dec(I,Arasa);
 238            end;
 239        end;
 240    until Arasa = 1;
 241  end; (* ShellSort *)
 242   
 243  procedure TFormSorting.QuickSort(IMin,IMax : TDataNo);
 244            (* クィックソート 再帰的 *)
 245  var
 246    Hole : TDataNo;
 247   
 248    procedure Split;
 249              (* Data[IMin] より大きいものと小さいものに分ける *)
 250    var
 251      No : TDataNo;
 252      Mid : TDataNo;
 253    begin
 254      Mid := (IMin+IMax) div 2;      // 中央
 255      Idou(Mid,0);                   // 中央を基準として取り出す
 256      Idou(IMin,Mid);                // 左端を穴にする
 257      Hole := IMin;                  // 
 258      for No := IMin+1 to IMax do    // 穴の右から右端まで調べる
 259        begin
 260          if Chiisai(0,No)           // 基準より大きいとき
 261            then begin
 262                   Idou(No,Hole);    // 穴に移し
 263                   Idou(Hole+1,No);  // 穴の右をその後に移す
 264                   Inc(Hole);        // 穴の右が新しい穴になる
 265                 end
 266        end;
 267      Idou(0,Hole);                  // 基準を穴に戻す
 268    end;  {Split}
 269   
 270  begin
 271    Split;                           // 大小２つのグループに分ける
 272    if Hole > IMin+1                 // 左グループに２個以上あるとき
 273      then QuickSort(IMin,Hole-1);
 274    if Hole < IMax-1                 // 右グループに２個以上あるとき
 275      then QuickSort(Hole+1,IMax);
 276  end; (* QuickSort *)
 277   
 278  (*********************** イベントハンドラー ********************)
 279   
 280  procedure TFormSorting.ButtonCloseClick(Sender: TObject);
 281  begin
 282    Close;
 283  end; (* ButtonCloseClick *)
 284   
 285  procedure TFormSorting.FormCreate(Sender: TObject);
 286  begin
 287    ClientWidth  := NoMax*PenWidth+PanelMain.Width;
 288    ClientHeight := DataMax;
 289    Canvas.Pen.Width := PenWidth;
 290    NewData;
 291  end; (* FormCreate *)
 292   
 293  procedure TFormSorting.ButtonNewClick(Sender: TObject);
 294  begin
 295    NewData;
 296  end; (* ButtonNewClick *)
 297   
 298  procedure TFormSorting.ButtonExecuteClick(Sender: TObject);
 299  var
 300    TimeStart,TimeEnd : TDateTime;
 301    Kara,Made : Integer;
 302  begin
 303    Kara := StrToInt(EditKara.Text);
 304    Made := StrToInt(EditMade.Text);
 305    if Kara < 1
 306      then Kara := 1;
 307    if Made > NoMax
 308      then Made := NoMax;
 309    Hyouji := RadioGroupHyouji.ItemIndex = 0;
 310    StandBy;
 311    IdouSuu := 0;
 312    HikakuSuu := 0;
 313    TimeStart := Now;
 314    case RadioGroupSort.ItemIndex of
 315      0 : BubbleSort0(Kara,Made);
 316      1 : BubbleSort(Kara,Made);
 317      2 : InsertSort0(Kara,Made);
 318      3 : InsertSort(Kara,Made);
 319      4 : ShellSort(Kara,Made);
 320      5 : QuickSort(Kara,Made);
 321    end;
 322    TimeEnd := Now;
 323    ByouSuu := (TimeEnd-TimeStart)*24*60*60;
 324    PanelIdou.Caption := Format('移動回数%10d 回',[IdouSuu]);
 325    PanelHikaku.Caption := Format('比較回数%10d 回',[HikakuSuu]);
 326    PanelJikan.Caption := Format('所要時間%10.2f 秒',[ByouSuu]);
 327  end; (* ButtonExecuteClick *)
 328   
 329  procedure TFormSorting.RadioGroupSortClick(Sender: TObject);
 330  begin
 331    StandBy;
 332  end; (* RadioGroupSortClick *)
 333   
 334  procedure TFormSorting.RadioGroupBunpuClick(Sender: TObject);
 335  begin
 336    NewData;
 337  end; (* RadioGroupBunpuClick *)
 338   
 339  procedure TFormSorting.TrackBarBunpuChange(Sender: TObject);
 340  begin
 341    NewData;
 342  end; (* TrackBarBunpuChange *)
 343   
 344  end.