home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 March / Chip_1999-03_cd.bin / zkuste / delphi / INFO / DI9810RS.ZIP / TOPO.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-01  |  9KB  |  306 lines
  1. unit Topo;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.     DependentPtr = ^Dependent;
  11.     ItemPtr      = ^Item;
  12.  
  13.     // A record to hold a pointer to a dependent item.
  14.     Dependent = record
  15.         DependentItem : ItemPtr;       // The dependent item.
  16.         NextDependent : DependentPtr;  // The next dependent Item.
  17.     end;
  18.  
  19.     // A record to hold an item's dependencies.
  20.     Item = record
  21.         ItemValue      : String[10];   // The item's name.
  22.         NumBefore      : Integer;      // # items before this one.
  23.         NextItem       : ItemPtr;      // Next item in the list.
  24.         PrevItem       : ItemPtr;      // Previous item in the list.
  25.         FirstDependent : DependentPtr; // First item after this one.
  26.     end;
  27.  
  28.   TTopoSortForm = class(TForm)
  29.     memInputs: TMemo;
  30.     memOutputs: TMemo;
  31.     cmdSolve: TButton;
  32.     procedure cmdSolveClick(Sender: TObject);
  33.  
  34.     procedure LoadData;
  35.     function FindItem(item_value : String) : ItemPtr;
  36.     procedure OrderData;
  37.     function MoveToReady(itm : ItemPtr) : ItemPtr;
  38.  
  39.     // For debugging:
  40.     procedure ShowStructure;
  41.   private
  42.     { Private declarations }
  43.   public
  44.     { Public declarations }
  45.   end;
  46.  
  47. var
  48.   TopoSortForm: TTopoSortForm;
  49.  
  50. implementation
  51. {$R *.DFM}
  52.  
  53. var
  54.     // Sentinels for Ready and NotReady lists.
  55.     NotReadyTop, NotReadyBottom : Item;
  56.  
  57.     // Sentinels for items without prerequisites.
  58.     ReadyTop, ReadyBottom : Item;
  59.  
  60. // Calculate a complete ordering.
  61. procedure TTopoSortForm.cmdSolveClick(Sender: TObject);
  62. begin
  63.     // Clear the output.
  64.     memOutputs.Clear;
  65.     memOutputs.Refresh;
  66.  
  67.     // Get the input data.
  68.     LoadData;
  69.  
  70.     // Find a complete ordering.
  71.     OrderData;
  72. end;
  73.  
  74. // Load the input data from the memInputs Memo control.
  75. procedure TTopoSortForm.LoadData;
  76. var
  77.     i, p                         : Integer;
  78.     the_line, dep_name, pre_name : String;
  79.     itm, dep_item, pre_item      : ItemPtr;
  80.     new_dep                      : DependentPtr;
  81. begin
  82.     // Initialize the doubly linked lists.
  83.     NotReadyTop.NextItem := @NotReadyBottom;
  84.     NotReadyTop.PrevItem := nil;
  85.     NotReadyBottom.PrevItem := @NotReadyTop;
  86.     NotReadyBottom.NextItem := nil;
  87.     NotReadyBottom.ItemValue := #255; // A big value.
  88.  
  89.     ReadyTop.NextItem := @ReadyBottom;
  90.     ReadyTop.PrevItem := nil;
  91.     ReadyBottom.PrevItem := @ReadyTop;
  92.     ReadyBottom.NextItem := nil;
  93.     ReadyBottom.ItemValue := #255;
  94.  
  95.     // Get the input data. Load all the items into
  96.     // the NotReady list.
  97.     for i := 0 to memInputs.Lines.Count - 1 do
  98.     begin
  99.         // Parse this line.
  100.         the_line := Trim(memInputs.Lines[i]);
  101.         if (the_line = '') then Continue;
  102.         
  103.         p := Pos(' ', the_line);
  104.         pre_name := Trim(Copy(the_line, 1, p - 1));
  105.         dep_name := Trim(Copy(the_line, p + 2, Length(the_line)));
  106.  
  107.         // Find the items.
  108.         pre_item := FindItem(pre_name);
  109.         dep_item := FindItem(dep_name);
  110.  
  111.         // Add dep_item to pre_item's dependent list.
  112.         // pre_item < dep_item.
  113.         GetMem(new_dep, SizeOf(Dependent));
  114.         new_dep^.DependentItem := dep_item;
  115.         new_dep^.NextDependent := pre_item^.FirstDependent;
  116.         pre_item^.FirstDependent := new_dep;
  117.         dep_item.NumBefore := dep_item.NumBefore + 1;
  118.     end;
  119.  
  120.     // Move items with no dependencies into the Ready list.
  121.     itm := NotReadyTop.NextItem;
  122.     while (itm <> @NotReadyBottom) do
  123.     begin
  124.         if (itm.NumBefore > 0) then
  125.         begin
  126.             // Leave this item in the NotReady list.
  127.             // Prepare to examine the next item.
  128.             itm := itm^.NextItem;
  129.         end else begin
  130.             // This item is ready for output.
  131.             // Move it to the Ready list.
  132.             itm := MoveToReady(itm);
  133.         end;
  134.     end; // End while (itm <> @NotReadyBottom) loop.
  135. end;
  136.  
  137. // Return a pointer to this item in the NotReady sorted
  138. // linked list. If the item is not present, insert it.
  139. function TTopoSortForm.FindItem(item_value : String) : ItemPtr;
  140. var
  141.     itm, new_item : ItemPtr;
  142. begin
  143.     // Search the NotReady list.
  144.     itm := NotReadyTop.NextItem;
  145.     while (itm^.ItemValue < item_value) do
  146.         itm := itm^.NextItem;
  147.  
  148.     // See if we found it.
  149.     if (itm^.ItemValue <> item_value) then
  150.     begin
  151.         // We did not. Add the item before itm.
  152.         GetMem(new_item, SizeOf(Item));
  153.         new_item^.ItemValue := item_value;
  154.         new_item^.NumBefore := 0;
  155.         new_item^.FirstDependent := nil;
  156.         new_item^.PrevItem := itm^.PrevItem;
  157.         new_item^.NextItem := itm;
  158.         itm^.PrevItem := new_item;
  159.         new_item^.PrevItem^.NextItem := new_item;
  160.  
  161.         // Make itm point to the new item.
  162.         itm := new_item;
  163.     end;
  164.  
  165.     Result := itm;
  166. end;
  167.  
  168. // Find a complete ordering and display it in memOutputs.
  169. procedure TTopoSortForm.OrderData;
  170. var
  171.     itm, dep_item : ItemPtr;
  172.     dep           : DependentPtr;
  173. begin
  174.     // While there are items in the Ready list, output one.
  175.     while (ReadyTop.NextItem <> @ReadyBottom) do
  176.     begin
  177.         // Remove the first item from the Ready list.
  178.         itm := ReadyTop.NextItem;
  179.         ReadyTop.NextItem := itm^.NextItem;
  180.         ReadyTop.NextItem^.PrevItem := @ReadyTop;
  181.  
  182.         // Add the item to the output.
  183.         memOutputs.Lines.Add(itm^.ItemValue);
  184.  
  185.         // Decrement NumBefore for all items that are
  186.         // dependent on this one.
  187.         dep := itm^.FirstDependent;
  188.         while (dep <> nil) do
  189.         begin
  190.             dep_item := dep^.DependentItem;
  191.             dep_item^.NumBefore := dep_item^.NumBefore - 1;
  192.             if (dep_item^.NumBefore < 1) then
  193.             begin
  194.                 // This item has no more dependents.
  195.                 // Move it to the Ready list.
  196.                 MoveToReady(dep_item);
  197.             end;
  198.  
  199.             // Free this Dependent record.
  200.             itm^.FirstDependent := dep^.NextDependent;
  201.             FreeMem(dep);
  202.  
  203.             // Go to itm's next Dependent record.
  204.             dep := itm^.FirstDependent;
  205.         end; // End while (dep <> nil) loop.
  206.     end; // End while there are items in the Ready list.
  207.  
  208.     // If there are still items in the NotReadyList, they
  209.     // cannot be ordered.
  210.     if (NotReadyTop.NextItem <> @NotReadyBottom) then
  211.     begin
  212.         memOutputs.Lines.Add('');
  213.         memOutputs.Lines.Add('Mutually dependent:');
  214.  
  215.         while (NotReadyTop.NextItem <> @NotReadyBottom) do
  216.         begin
  217.             // Remove the first item from the NotReady list.
  218.             itm := NotReadyTop.NextItem;
  219.             NotReadyTop.NextItem := itm^.NextItem;
  220.  
  221.             // Add the item to the output.
  222.             memOutputs.Lines.Add(itm^.ItemValue);
  223.  
  224.             // Remove the dependents for itm.
  225.             dep := itm^.FirstDependent;
  226.             while (dep <> nil) do
  227.             begin
  228.                 // Free this Dependent record.
  229.                 itm^.FirstDependent := dep^.NextDependent;
  230.                 FreeMem(dep);
  231.  
  232.                 // Go to itm's next Dependent record.
  233.                 dep := itm^.FirstDependent;
  234.             end;
  235.         end; // End while NotReady list is not empty.
  236.     end; // End if there are items still in the NotReady list.
  237. end;
  238.  
  239. // Move the indicated item to the Ready list. Leave itm
  240. // pointing to the next item in the original list.
  241. function TTopoSortForm.MoveToReady(itm : ItemPtr) : ItemPtr;
  242. var
  243.     after_me, before_me : ItemPtr;
  244. begin
  245.     // This item is ready for output.
  246.     after_me  := itm^.PrevItem;
  247.     before_me := itm^.NextItem;
  248.  
  249.     // Remove itm from the NotReadyList.
  250.     after_me^.NextItem := before_me;
  251.     before_me^.PrevItem := after_me;
  252.  
  253.     // Add itm to the Ready list.
  254.     itm^.PrevItem := @ReadyTop;
  255.     itm^.NextItem := ReadyTop.NextItem;
  256.     itm^.NextItem^.PrevItem := itm;
  257.     ReadyTop.NextItem := itm;
  258.  
  259.     // Return the item after itm in its original list.
  260.     Result := before_me;
  261. end;
  262.  
  263. // This routine presents a message box displaying the
  264. // data structure's current configuration. It is useful
  265. // for showing what the data looks like ad the program
  266. // progresses and helps with debugging.
  267. procedure TTopoSortForm.ShowStructure;
  268. var
  269.     txt : String;
  270.     itm : ItemPtr;
  271.     dep : DependentPtr;
  272. begin
  273.     txt := 'Ready: ' + #10 + #13;
  274.     itm := ReadyTop.NextItem;
  275.     while (itm <> @ReadyBottom) do
  276.     begin
  277.         txt := txt + itm^.ItemValue +
  278.             '(' + IntToStr(itm^.NumBefore) + ')' + #10 + #13;
  279.         dep := itm^.FirstDependent;
  280.         while (dep <> nil) do
  281.         begin
  282.             txt := txt + '    ' + dep^.DependentItem^.ItemValue + #10 + #13;
  283.             dep := dep^.NextDependent;
  284.         end;
  285.         itm := itm^.NextItem;
  286.     end;
  287.  
  288.     txt := txt + #10 + #13 + 'Not Ready: ' + #10 + #13;
  289.     itm := NotReadyTop.NextItem;
  290.     while (itm <> @NotReadyBottom) do
  291.     begin
  292.         txt := txt + itm^.ItemValue +
  293.             '(' + IntToStr(itm^.NumBefore) + ')' + #10 + #13;
  294.         dep := itm^.FirstDependent;
  295.         while (dep <> nil) do
  296.         begin
  297.             txt := txt + '    ' + dep^.DependentItem^.ItemValue + #10 + #13;
  298.             dep := dep^.NextDependent;
  299.         end;
  300.         itm := itm^.NextItem;
  301.     end;
  302.     ShowMessage(txt);
  303. end;
  304.  
  305. end.
  306.