fork download
copy 
  1. program QuickSortTest;
  2.  
  3. {$MODE OBJFPC}{$LONGSTRINGS ON}
  4.  
  5. uses
  6.   HeapTrc;
  7.  
  8. type
  9.   TData = Integer;
  10.   PData = ^TData;
  11.  
  12. type
  13.   PNode = ^TNode;
  14.   TNode = record
  15.     Next: PNode;
  16.     Prev: PNode;
  17.     Data: PData;
  18.   end;
  19.  
  20. type
  21.   PList = ^TList;
  22.   TList = record
  23.     Head: PNode;
  24.     Tail: PNode;
  25.   end;
  26.  
  27.   procedure SwapNodesData(var ALow, AHigh: PData);
  28.   var
  29.     Temp: PData;
  30.   begin
  31.     Temp := ALow;
  32.     ALow := AHigh;
  33.     AHigh := Temp;
  34.   end;
  35.  
  36.   function GetPivotNode(ALow, AHigh: PNode): PNode;
  37.   var
  38.     Data: PData;
  39.     Left, Right: PNode;
  40.   begin
  41.     Data := AHigh^.Data;
  42.     Left := ALow^.Prev;
  43.     Right := ALow;
  44.  
  45.     while Right <> AHigh do
  46.     begin
  47.       if Right^.Data^ < Data^ then
  48.       begin
  49.         if Left = nil then
  50.           Left := ALow
  51.         else
  52.           Left := Left^.Next;
  53.  
  54.         SwapNodesData(Left^.Data, Right^.Data);
  55.       end;
  56.  
  57.       Right := Right^.Next;
  58.     end;
  59.  
  60.     if Left = nil then
  61.       Left := ALow
  62.     else
  63.       Left := Left^.Next;
  64.  
  65.     SwapNodesData(Left^.Data, AHigh^.Data);
  66.     Result := Left;
  67.   end;
  68.  
  69.   procedure QuickSortList(ALow, AHigh: PNode);
  70.   var
  71.     Pivot: PNode;
  72.   begin
  73.     if (AHigh <> nil) and (ALow <> AHigh) and (ALow <> AHigh^.Next) then
  74.     begin
  75.       Pivot := GetPivotNode(ALow, AHigh);
  76.  
  77.       QuickSortList(ALow, Pivot^.Prev);
  78.       QuickSortList(Pivot^.Next, AHigh);
  79.     end;
  80.   end;
  81.  
  82.   procedure CreateList(out AList: PList);
  83.   begin
  84.     New(AList);
  85.     AList^ := default(TList);
  86.   end;
  87.  
  88.   procedure DisposeList(var AList: PList);
  89.   var
  90.     Current, Next: PNode;
  91.   begin
  92.     Current := AList^.Head;
  93.  
  94.     while Current <> nil do
  95.     begin
  96.       Next := Current^.Next;
  97.  
  98.       Dispose(Current^.Data);
  99.       Dispose(Current);
  100.  
  101.       Current := Next;
  102.     end;
  103.  
  104.     Dispose(AList);
  105.     AList := nil;
  106.   end;
  107.  
  108.   procedure AddDataToList(AList: PList; AData: TData);
  109.   var
  110.     Fresh: PNode;
  111.   begin
  112.     New(Fresh);
  113.     New(Fresh^.Data);
  114.  
  115.     Fresh^.Data^ := AData;
  116.     Fresh^.Next := nil;
  117.  
  118.     if AList^.Head = nil then
  119.     begin
  120.       AList^.Head := Fresh;
  121.       AList^.Tail := Fresh;
  122.       AList^.Head^.Prev := nil;
  123.     end
  124.     else
  125.     begin
  126.       AList^.Tail^.Next := Fresh;
  127.       Fresh^.Prev := AList^.Tail;
  128.       AList^.Tail := Fresh;
  129.     end;
  130.   end;
  131.  
  132.   procedure FillList(List: PList);
  133.   var
  134.     Index: Integer;
  135.   begin
  136.     for Index := 0 to 15 do
  137.       AddDataToList(List, Random(10));
  138.   end;
  139.  
  140.   procedure PrintListFromHead(AList: PList);
  141.   var
  142.     Current: PNode;
  143.   begin
  144.     Current := AList^.Head;
  145.  
  146.     while Current <> nil do
  147.     begin
  148.       Write(Current^.Data^:2);
  149.       Current := Current^.Next;
  150.     end;
  151.  
  152.     WriteLn();
  153.   end;
  154.  
  155.   procedure PrintListFromTail(AList: PList);
  156.   var
  157.     Current: PNode;
  158.   begin
  159.     Current := AList^.Tail;
  160.  
  161.     while Current <> nil do
  162.     begin
  163.       Write(Current^.Data^:2);
  164.       Current := Current^.Prev;
  165.     end;
  166.  
  167.     WriteLn();
  168.   end;
  169.  
  170.   procedure PrintList(AList: PList; const ATitle: String);
  171.   begin
  172.     WriteLn(ATitle, LineEnding);
  173.  
  174.     Write('from head:');
  175.     PrintListFromHead(AList);
  176.  
  177.     Write('from tail:');
  178.     PrintListFromTail(AList);
  179.  
  180.     WriteLn();
  181.   end;
  182.  
  183. var
  184.   List: PList;
  185. begin
  186.   Randomize();
  187.  
  188.   CreateList(List);
  189.   FillList(List);
  190.  
  191.   PrintList(List, 'before sorting:');
  192.   QuickSortList(List^.Head, List^.Tail);
  193.   PrintList(List, 'after sorting:');
  194.  
  195.   DisposeList(List);
  196. end.
  197.  
Success #stdin #stdout #stderr 0s 4224KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
before sorting:

from head: 7 2 7 5 8 1 4 1 0 2 6 3 6 4 3 3
from tail: 3 3 4 6 3 6 2 0 1 4 1 8 5 7 2 7

after sorting:

from head: 0 1 1 2 2 3 3 3 4 4 5 6 6 7 7 8
from tail: 8 7 7 6 6 5 4 4 3 3 3 2 2 1 1 0
stderr
copy 
Heap dump by heaptrc unit
33 memory blocks allocated : 464/528
33 memory blocks freed     : 464/528
0 unfreed memory blocks : 0
True heap size : 65536
True free heap : 65536
https://ideone.com/xh3uc5
language:
Pascal (fpc 3.0.4)
created:
5 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!