Merge Sort

Program ChuongTrinh;
uses crt;
const Max = 100;
type Mang = array [1..Max] of integer;
var n: integer;
    A, B: Mang;
    Flag: boolean;

    procedure Nhap;
    var i: integer;
    begin
         write('Nhap so luong phan tu : '); readln(n);
         for i:= 1 to n do
         begin
              write('Nhap phan tu thu ', i, ': '); readln(A[i]);
         end;
    end;

    procedure Meger(var X, Y: Mang; a, b, c: integer);
    { Tron X[a..b] voi X[b+1..c] thanh Y[a..c] }
    var i, j, k: integer;
    begin
         i:= a;
         j:= b+1;
         k:= a;
         while (i <= b) and (j <= c) do
         begin
              if X[i] < X[j] then
              begin
                   Y[k]:= X[i];
                   inc(i); { Tang i len 1 don vi }
              end
                 else begin
                           Y[k]:= X[j];
                           inc(j);
                      end;
              inc(k);
         end;
         if i <= b then { Mach X[a..b] van con }
         begin
              while i <= b do
              begin
                   Y[k]:= X[i];
                   inc(i);
                   inc(k);
              end;
         end
            else begin
                      while j <= c do
                      begin
                           Y[k]:= X[j];
                           inc(j);
                           inc(k);
                      end;
                 end;
    end;

    procedure MegerByLength(var X, Y: Mang; len: integer);
    var a, b, c, i: integer;
    begin
         a:= 1; b:= len; c:= 2*len;
         while c <= n do
         begin
              Meger(X, Y, a, b, c);
              a:= a + 2*len;
              b:= b + 2*len;
              c:= c + 2*len;
         end;
         { Thoat ra khoi vong While thi c > n nen: }
         if b < n then { Con lai 2 mach trong do mach 2 co chieu dai < len }
              Meger(X, Y, a, b, n)
            else { b >= n: Con lai mot mach }
            begin
                 for i:= a to n do Y[i]:= X[i];
            end;
    end;

    procedure MegerSort;
    var len: integer;
    begin
         Flag:= True;
         len:= 1;
         while len < n do
         begin
              if Flag then MegerByLength(A, B, len)
                 else MegerByLength(B, A, len);
              len:= 2*len;
              Flag:= not Flag;
         end;
         if not Flag then A:= B;
    end;

    procedure HienThi;
    var i: integer;
    begin
         writeln('Day sau khi sap xep la: ');
         for i:= 1 to n do write(A[i]:5);
    end;

Begin { Chuong Trinh Chinh }
      clrscr;
      Nhap;
      MegerSort;
      HienThi;
      readln;
End.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: