[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]

    { I've been working on a project for most of this year found the SWAG
    group a valuable resource for ideas. I've written a mergesort that I
    thought others may find of interest. It is written for a doubly
    linked list because that is what I needed, but I'm sure it can be
    adapted for a single linked list and with a bit more work probably
    arrays.

    On a 486DX-50 it repeatly sorted a list of 20000 elements in less
    than 0.9 of a second (unless I've done something wrong with the
    timing).

    It is wrapped up in a test program and generates an output file
    called 'SORTTEXT.TXT' which includes the initial unsorted list, the
    sorted list and the approximate time taken to sort the list. It
    should compile straight away.
    }

    program MergeTest;

    uses Dos;{for GetTime}

    type
       PNodeType = ^NodeType;

       NodeType = record Val  : integer;   {The Value of the node}
          Prev : PNodeType; {The Previous Node in the List. This equals nil when first in list}
          Next : PNodeType; {The Next Node in the List. This equals nil when last in list}
       end;

    var
       TheList      : PNodeType;
       TempList     : PNodeType;

       N            : integer;
       Count        : integer;

       OutFile      : text;

       Hundredths   : word;    {                               }
       Hundredths2  : word;    {                               }
       Seconds      : word;    {                               }
       Seconds2     : word;    {                               }
       Minutes      : word;    {       Used for timing         }
       Minutes2     : word;    {                               }
       Hours        : word;    {                               }
       Hours2       : word;    {                               }
       Total        : longint; {                               }
       Total2       : longint; {                               }

       procedure ShowList(TheList : PNodeType);
       {This procedure will take a List of PNodeType and write it to a file}

       var
          Count    : integer;
          TempList : PNodeType;

       begin
          TempList := TheList;
          Count := 1;
          while TempList <> nil do
          begin
             if TempList^.Prev <> nil then
                writeln(OutFile,'  Prev : ',TempList^.Prev^.Val)
             else
                writeln(OutFile,'  Prev = nil');

             writeln(OutFile,'Val No : ',Count,' is ',TempList^.Val);

             if TempList^.Next <> nil then
                writeln(OutFile,'  Next : ',TempList^.Next^.Val)
             else
                writeln(OutFile,'  Next = nil');

             writeln(OutFile);
             TempList := TempList^.Next;
             inc(Count);
          end;
          writeln(OutFile,'The Node = nil');
          writeln(OutFile);
       end;

       function MergeSort(TheList : PNodeType; N : integer) : PNodeType;
       {This procedure is the MergeSort. It recursively calls itself to sort the
        list}

       var
          TempNode1  : PNodeType;
          TempNode2  : PNodeType;
          Count      : integer;
          Size1      : integer;
          Size2      : integer;
          UsingList1 : boolean;

       begin
          {check for two or less elements}

          if N <= 2 then
          begin
             if N = 1 then               {one element in the list}
                MergeSort := TheList     {a one element list is already sorted}
             else
             begin                       {two elements in the list}

                {if the two elements are already sorted, return the list else
                 swap them and return the list}

                if TheList^.Val < TheList^.Next^.Val then
                   MergeSort := TheList
                else
                begin
                   TempNode1 := TheList;
                   TempNode2 := TheList^.Next;
                   TempNode1^.Prev := TempNode2;
                   TempNode2^.Next := TempNode1;
                   TempNode1^.Next := nil;
                   TempNode2^.Prev := nil;
                   MergeSort := TempNode2;
                end;
             end;
          end
          else
          begin
             {more than two element in the list}

             {split the list in to two half lists}
                {TempNode1 holds the first list}
                {TempNode2 holds the second list}

             TempNode2 := TheList;
             Size1 := N div 2;
             Size2 := n - Size1;
             for Count := 1 to Size1 - 1 do
                TempNode2 := TempNode2^.Next;
             TempNode1 := TempNode2;
             TempNode2 := TempNode2^.Next;
             TempNode1^.Next := nil;
             TempNode2^.Prev := nil;
             TempNode1 := TheList;

             {sort the two half lists}

             TempNode1 := MergeSort(TempNode1,Size1);
             TempNode2 := MergeSort(TempNode2,Size2);

             {Merge the two sorted lists}
                {Select which list to start with}
                {When UsingList1 is true then the list being moved through is
                 the first list (TempNode1) else it is the second list
                 (TempNode2)}

             if TempNode1^.Val < TempNode2^.Val then
             begin
                MergeSort := TempNode1;
                UsingList1 := true;
             end
             else
             begin
                MergeSort := TempNode2;
                UsingList1 := false;
             end;

             while (TempNode1 <> nil) and (TempNode2 <> nil) do
             begin
                {A procedure could be used to replace the two branches of this
                 if statement}

                {This is where the merge takes place}

                if UsingList1 then
                begin
                   while (TempNode1^.next <> nil) and
                         (TempNode1^.Next^.Val < TempNode2^.Val) do
                                    {^ Sort criteria ^}
                      TempNode1 := TempNode1^.Next;
                   TempNode2^.Prev := TempNode1;
                   TempNode1 := TempNode1^.Next;
                   TempNode2^.Prev^.Next := TempNode2;
                   if TempNode1 = nil then
                      exit;
                end
                else
                begin
                   while (TempNode2^.next <> nil) and
                         (TempNode2^.Next^.Val < TempNode1^.Val) do
                                    {^ Sort criteria ^}
                      TempNode2 := TempNode2^.Next;
                   TempNode1^.Prev := TempNode2;
                   TempNode2 := TempNode2^.Next;
                   TempNode1^.Prev^.Next := TempNode1;
                   if TempNode2 = nil then
                      exit;
                end;
                UsingList1 := not UsingList1;
             end;

          end;
       end;

    begin
       {Small piece of code to test the sort}
       N := 20000;                        {Change this to vary the number of
                                           elements in the linked list}
       randomize;

       {Create the list}

       writeln('Initialising List');
       new(TheList);
       TheList^.Val := random(500);
       TheList^.Prev := nil;
       TempList := TheList;
       for Count := 2 to N do
       begin
          new(TempList^.Next);
          TempList^.Next^.Prev := TempList;
          TempList := TempList^.Next;
          TempList^.Val := random(500);
       end;
       TempList^.next := nil;

       {Write the list to file}
       writeln('Writing Initial list to file');
       assign(OutFile,'SortText.Txt');              {The name of the output file}
       rewrite(OutFile);
       writeln(OutFile,'----- Initial List -----');
       writeln(OutFile);
       ShowList(TheList);
       close(OutFile);

       writeln('Sorting List of ', N ,' elements');
       {Get the start time}
       GetTime(Hours,Minutes,Seconds,Hundredths);

       {Sort the list}
       TheList := mergesort(TheList,N);

       {Get the end time}
       GetTime(Hours2,Minutes2,Seconds2,Hundredths2);

       writeln('List Sorted');

       {Calculate the difference (I'm sure there's a better way)}
       Total := Hours * 360000 + Minutes * 6000 + Seconds * 100 + Hundredths;
       Total2 := Hours2 * 360000 + Minutes2 * 6000 + Seconds2 * 100 + Hundredths2;

       {Display Time taken}
       writeln('Approx Time Taken : ',Total2 - Total,' hundredths of a second');

       {Write the sorted list and the results to file}
       writeln('Writing Sorted list to File');
       writeln;
       append(OutFile);
       writeln(OutFile,'----- Sorted  List -----');
       writeln(OutFile);
       ShowList(TheList);
       writeln(OutFile,'Approx Time Taken : ',Total2 - Total,' hundredths of a second');
       close(OutFile);

    end.

[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]