413 lines
14 KiB
ObjectPascal
413 lines
14 KiB
ObjectPascal
program topologicalsortrosetta;
|
|
|
|
{*
|
|
Topological sorter to parse e.g. dependencies.
|
|
Written for FreePascal 2.4.x/2.5.1. Probably works in Delphi, but you'd have to
|
|
change some units.
|
|
*}
|
|
{$IFDEF FPC}
|
|
// FreePascal-specific setup
|
|
{$mode objfpc}
|
|
uses {$IFDEF UNIX}
|
|
cwstring, {* widestring support for unix *} {$IFDEF UseCThreads}
|
|
cthreads, {$ENDIF UseCThreads} {$ENDIF UNIX}
|
|
Classes,
|
|
SysUtils;
|
|
{$ENDIF}
|
|
|
|
type
|
|
RNodeIndex = record
|
|
NodeName: WideString; //Name of the node
|
|
//Index: integer; //Index number used in DepGraph. For now, we can distill the index from the array index. If we want to use a TList or similar, we'd need an index property
|
|
Order: integer; //Order when sorted
|
|
end;
|
|
|
|
RDepGraph = record
|
|
Node: integer; //Refers to Index in NodeIndex
|
|
DependsOn: integer; //The Node depends on this other Node.
|
|
end;
|
|
|
|
{ TTopologicalSort }
|
|
|
|
TTopologicalSort = class(TObject)
|
|
private
|
|
Nodes: array of RNodeIndex;
|
|
DependencyGraph: array of RDepGraph;
|
|
FCanBeSorted: boolean;
|
|
function SearchNode(NodeName: WideString): integer;
|
|
function SearchIndex(NodeID: integer): WideString;
|
|
function DepFromNodeID(NodeID: integer): integer;
|
|
function DepFromDepID(DepID: integer): integer;
|
|
function DepFromNodeIDDepID(NodeID, DepID: integer): integer;
|
|
procedure DelDependency(const Index: integer);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure SortOrder(var Output: TStringList);
|
|
procedure AddNode(NodeName: WideString);
|
|
procedure AddDependency(NodeName, DependsOn: WideString);
|
|
procedure AddNodeDependencies(NodeAndDependencies: TStringList);
|
|
//Each string has node, and the nodes it depends on. This allows insertion of an entire dependency graph at once
|
|
//procedure DelNode(NodeName: Widestring);
|
|
procedure DelDependency(NodeName, DependsOn: WideString);
|
|
|
|
property CanBeSorted: boolean read FCanBeSorted;
|
|
|
|
end;
|
|
|
|
const
|
|
INVALID = -1;
|
|
// index not found for index search functions, no sort order defined, or record invalid/deleted
|
|
|
|
function TTopologicalSort.SearchNode(NodeName: WideString): integer;
|
|
var
|
|
Counter: integer;
|
|
begin
|
|
// Return -1 if node not found. If node found, return index in array
|
|
Result := INVALID;
|
|
for Counter := 0 to High(Nodes) do
|
|
begin
|
|
if Nodes[Counter].NodeName = NodeName then
|
|
begin
|
|
Result := Counter;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTopologicalSort.SearchIndex(NodeID: integer): WideString;
|
|
//Look up name for the index
|
|
begin
|
|
if (NodeID > 0) and (NodeID <= High(Nodes)) then
|
|
begin
|
|
Result := Nodes[NodeID].NodeName;
|
|
end
|
|
else
|
|
begin
|
|
Result := 'ERROR'; //something's fishy, this shouldn't happen
|
|
end;
|
|
end;
|
|
|
|
function TTopologicalSort.DepFromNodeID(NodeID: integer): integer;
|
|
// Look for Node index number in the dependency graph
|
|
// and return the first node found. If nothing found, return -1
|
|
var
|
|
Counter: integer;
|
|
begin
|
|
Result := INVALID;
|
|
for Counter := 0 to High(DependencyGraph) do
|
|
begin
|
|
if DependencyGraph[Counter].Node = NodeID then
|
|
begin
|
|
Result := Counter;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTopologicalSort.DepFromDepID(DepID: integer): integer;
|
|
// Look for dependency index number in the dependency graph
|
|
// and return the index for the first one found. If nothing found, return -1
|
|
var
|
|
Counter: integer;
|
|
begin
|
|
Result := INVALID;
|
|
for Counter := 0 to High(DependencyGraph) do
|
|
begin
|
|
if DependencyGraph[Counter].DependsOn = DepID then
|
|
begin
|
|
Result := Counter;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTopologicalSort.DepFromNodeIDDepID(NodeID, DepID: integer): integer;
|
|
// Shows index for the dependency from NodeID on DepID, or INVALID if not found
|
|
var
|
|
Counter: integer;
|
|
begin
|
|
Result := INVALID;
|
|
for Counter := 0 to High(DependencyGraph) do
|
|
begin
|
|
if DependencyGraph[Counter].Node = NodeID then
|
|
if DependencyGraph[Counter].DependsOn = DepID then
|
|
begin
|
|
Result := Counter;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTopologicalSort.DelDependency(const Index: integer);
|
|
// Removes dependency from array.
|
|
// Is fastest when the dependency is near the top of the array
|
|
// as we're copying the remaining elements.
|
|
var
|
|
Counter: integer;
|
|
OriginalLength: integer;
|
|
begin
|
|
OriginalLength := Length(DependencyGraph);
|
|
if Index = OriginalLength - 1 then
|
|
begin
|
|
SetLength(DependencyGraph, OriginalLength - 1);
|
|
end;
|
|
if Index < OriginalLength - 1 then
|
|
begin
|
|
for Counter := Index to OriginalLength - 2 do
|
|
begin
|
|
DependencyGraph[Counter] := DependencyGraph[Counter + 1];
|
|
end;
|
|
SetLength(DependencyGraph, OriginalLength - 1);
|
|
end;
|
|
if Index > OriginalLength - 1 then
|
|
begin
|
|
// This could happen when deleting on an empty array:
|
|
raise Exception.Create('Tried to delete index ' + IntToStr(Index) +
|
|
' while the maximum index was ' + IntToStr(OriginalLength - 1));
|
|
end;
|
|
end;
|
|
|
|
constructor TTopologicalSort.Create;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TTopologicalSort.Destroy;
|
|
begin
|
|
// Clear up data just to make sure:
|
|
Finalize(DependencyGraph);
|
|
Finalize(Nodes);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTopologicalSort.SortOrder(var Output: TStringList);
|
|
var
|
|
Counter: integer;
|
|
NodeCounter: integer;
|
|
OutputSortOrder: integer;
|
|
DidSomething: boolean; //used to detect cycles (circular references)
|
|
Node: integer;
|
|
begin
|
|
OutputSortOrder := 0;
|
|
DidSomething := True; // prime the loop below
|
|
FCanBeSorted := True; //hope for the best.
|
|
while (DidSomething = True) do
|
|
begin
|
|
// 1. Find all nodes (now) without dependencies, output them first and remove the dependencies:
|
|
// 1.1 Nodes that are not present in the dependency graph at all:
|
|
for Counter := 0 to High(Nodes) do
|
|
begin
|
|
if DepFromNodeID(Counter) = INVALID then
|
|
begin
|
|
if DepFromDepID(Counter) = INVALID then
|
|
begin
|
|
// Node doesn't occur in either side of the dependency graph, so it has sort order 0:
|
|
DidSomething := True;
|
|
if (Nodes[Counter].Order = INVALID) or
|
|
(Nodes[Counter].Order > OutputSortOrder) then
|
|
begin
|
|
// Enter sort order if the node doesn't have a lower valid order already.
|
|
Nodes[Counter].Order := OutputSortOrder;
|
|
end;
|
|
end; //Invalid Dep
|
|
end; //Invalid Node
|
|
end; //Count
|
|
// Done with the first batch, so we can increase the sort order:
|
|
OutputSortOrder := OutputSortOrder + 1;
|
|
// 1.2 Nodes that are only present on the right hand side of the dep graph:
|
|
DidSomething := False;
|
|
// reverse order so we can delete dependencies without passing upper array
|
|
for Counter := High(DependencyGraph) downto 0 do
|
|
begin
|
|
Node := DependencyGraph[Counter].DependsOn; //the depended node
|
|
if (DepFromNodeID(Node) = INVALID) then
|
|
begin
|
|
DidSomething := True;
|
|
//Delete dependency so we don't hit it again:
|
|
DelDependency(Counter);
|
|
if (Nodes[Node].Order = INVALID) or (Nodes[Node].Order > OutputSortOrder) then
|
|
begin
|
|
// Enter sort order if the node doesn't have a lower valid order already.
|
|
Nodes[Node].Order := OutputSortOrder;
|
|
end;
|
|
end;
|
|
OutputSortOrder := OutputSortOrder + 1; //next iteration
|
|
end;
|
|
// 2. Go back to 1 until we can't do more work, and do some bookkeeping:
|
|
OutputSortOrder := OutputSortOrder + 1;
|
|
end; //outer loop for 1 to 2
|
|
OutputSortOrder := OutputSortOrder - 1; //fix unused last loop.
|
|
|
|
// 2. If we have dependencies left, we have a cycle; exit.
|
|
if (High(DependencyGraph) > 0) then
|
|
begin
|
|
FCanBeSorted := False; //indicate we have a cycle
|
|
Output.Add('Cycle (circular dependency) detected, cannot sort further. Dependencies left:');
|
|
for Counter := 0 to High(DependencyGraph) do
|
|
begin
|
|
Output.Add(SearchIndex(DependencyGraph[Counter].Node) +
|
|
' depends on: ' + SearchIndex(DependencyGraph[Counter].DependsOn));
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// No cycle:
|
|
// Now parse results, if we have them
|
|
for Counter := 0 to OutputSortOrder do
|
|
begin
|
|
for NodeCounter := 0 to High(Nodes) do
|
|
begin
|
|
if Nodes[NodeCounter].Order = Counter then
|
|
begin
|
|
Output.Add(Nodes[NodeCounter].NodeName);
|
|
end;
|
|
end; //output each result
|
|
end; //order iteration
|
|
end; //cycle detection
|
|
end;
|
|
|
|
procedure TTopologicalSort.AddNode(NodeName: WideString);
|
|
var
|
|
NodesNewLength: integer;
|
|
begin
|
|
// Adds node; make sure we don't add duplicate entries
|
|
if SearchNode(NodeName) = INVALID then
|
|
begin
|
|
NodesNewLength := Length(Nodes) + 1;
|
|
SetLength(Nodes, NodesNewLength);
|
|
Nodes[NodesNewLength - 1].NodeName := NodeName; //Arrays are 0 based
|
|
//Nodes[NodesNewLength -1].Index := //If we change the object to a tlist or something, we already have an index property
|
|
Nodes[NodesNewLength - 1].Order := INVALID; //default value
|
|
end;
|
|
end;
|
|
|
|
procedure TTopologicalSort.AddDependency(NodeName, DependsOn: WideString);
|
|
begin
|
|
// Make sure both nodes in the dependency exist as a node
|
|
if SearchNode(NodeName) = INVALID then
|
|
begin
|
|
Self.AddNode(NodeName);
|
|
end;
|
|
if SearchNode(DependsOn) = INVALID then
|
|
begin
|
|
Self.AddNode(DependsOn);
|
|
end;
|
|
// Add the dependency, only if we don't depend on ourselves:
|
|
if NodeName <> DependsOn then
|
|
begin
|
|
SetLength(DependencyGraph, Length(DependencyGraph) + 1);
|
|
DependencyGraph[High(DependencyGraph)].Node := SearchNode(NodeName);
|
|
DependencyGraph[High(DependencyGraph)].DependsOn := SearchNode(DependsOn);
|
|
end;
|
|
end;
|
|
|
|
procedure TTopologicalSort.AddNodeDependencies(NodeAndDependencies: TStringList);
|
|
// Takes a stringlist containing a list of strings. Each string contains node names
|
|
// separated by spaces. The first node depends on the others. It is permissible to have
|
|
// only one node name, which doesn't depend on anything.
|
|
// This procedure will add the dependencies and the nodes in one go.
|
|
var
|
|
Deplist: TStringList;
|
|
StringCounter: integer;
|
|
NodeCounter: integer;
|
|
begin
|
|
if Assigned(NodeAndDependencies) then
|
|
begin
|
|
DepList := TStringList.Create;
|
|
try
|
|
for StringCounter := 0 to NodeAndDependencies.Count - 1 do
|
|
begin
|
|
// For each string in the argument: split into names, and process:
|
|
DepList.Delimiter := ' '; //use space to separate the entries
|
|
DepList.StrictDelimiter := False; //allows us to ignore double spaces in input.
|
|
DepList.DelimitedText := NodeAndDependencies[StringCounter];
|
|
for NodeCounter := 0 to DepList.Count - 1 do
|
|
begin
|
|
if NodeCounter = 0 then
|
|
begin
|
|
// Add the first node, which might be the only one.
|
|
Self.AddNode(Deplist[0]);
|
|
end;
|
|
|
|
if NodeCounter > 0 then
|
|
begin
|
|
// Only add dependency from the second item onwards
|
|
// The AddDependency code will automatically add Deplist[0] to the Nodes, if required
|
|
Self.AddDependency(DepList[0], DepList[NodeCounter]);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
DepList.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTopologicalSort.DelDependency(NodeName, DependsOn: WideString);
|
|
// Delete the record.
|
|
var
|
|
NodeID: integer;
|
|
DependsID: integer;
|
|
Dependency: integer;
|
|
begin
|
|
NodeID := Self.SearchNode(NodeName);
|
|
DependsID := Self.SearchNode(DependsOn);
|
|
if (NodeID <> INVALID) and (DependsID <> INVALID) then
|
|
begin
|
|
// Look up dependency and delete it.
|
|
Dependency := Self.DepFromNodeIDDepID(NodeID, DependsID);
|
|
if (Dependency <> INVALID) then
|
|
begin
|
|
Self.DelDependency(Dependency);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Main program:
|
|
var
|
|
InputList: TStringList; //Lines of dependencies
|
|
TopSort: TTopologicalSort; //Topological sort object
|
|
OutputList: TStringList; //Sorted dependencies
|
|
Counter: integer;
|
|
begin
|
|
|
|
//Actual sort
|
|
InputList := TStringList.Create;
|
|
// Add rosetta code sample input separated by at least one space in the lines
|
|
InputList.Add(
|
|
'des_system_lib std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee');
|
|
InputList.Add('dw01 ieee dw01 dware gtech');
|
|
InputList.Add('dw02 ieee dw02 dware');
|
|
InputList.Add('dw03 std synopsys dware dw03 dw02 dw01 ieee gtech');
|
|
InputList.Add('dw04 dw04 ieee dw01 dware gtech');
|
|
InputList.Add('dw05 dw05 ieee dware');
|
|
InputList.Add('dw06 dw06 ieee dware');
|
|
InputList.Add('dw07 ieee dware');
|
|
InputList.Add('dware ieee dware');
|
|
InputList.Add('gtech ieee gtech');
|
|
InputList.Add('ramlib std ieee');
|
|
InputList.Add('std_cell_lib ieee std_cell_lib');
|
|
InputList.Add('synopsys');
|
|
TopSort := TTopologicalSort.Create;
|
|
OutputList := TStringList.Create;
|
|
try
|
|
TopSort.AddNodeDependencies(InputList); //read in nodes
|
|
TopSort.SortOrder(OutputList); //perform the sort
|
|
for Counter := 0 to OutputList.Count - 1 do
|
|
begin
|
|
writeln(OutputList[Counter]);
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
Writeln(stderr, 'Error: ', DateTimeToStr(Now),
|
|
': Error sorting. Technical details: ',
|
|
E.ClassName, '/', E.Message);
|
|
end;
|
|
end; //try
|
|
OutputList.Free;
|
|
TopSort.Free;
|
|
InputList.Free;
|
|
end.
|