Bandbreitenoptimierung für Matrizen

[BUG]

Zitat von Bjoerk:

Stab 1: von Knoten 1 nach Knoten 2
Stab 2: von Knoten 2 nach Knoten 5
Stab 3: von Knoten 5 nach Knoten 3
Stab 4: von Knoten 3 nach Knoten 4

Ich hab noch mal darüber nachgedacht. Im Prinzip hast du hier ja schon einen Graphen. Die Stäbe sind die Kanten und die Knoten sind ... die Knoten.

Wenn ich dich richtig verstehe, erstellst du daraus die folgende Matrix:

Code:

 | 1 2 3 4 5
------------
1| - 1 0 0 0
2| 1 - 0 0 1
3| 0 0 - 1 1
4| 0 0 1 - 0
5| 0 1 1 0 -

Das ist dann auch schon die Verbindung zwischen symmetrischen Matrizen und ungerichteten Graphen. Wenn das so stimmt, kannst du deinen Graphen direkt für die Cuthill-McKee-Algorithmus benutzen.
Der Algorithmus in der Zip-Datei benutzt eine Adjazenzliste zur Speicherung des Graphen und den schnellen Zugriff; so eine ähnliche Datenstruktur hast du bestimmt schon irgendwo herumzuliegen.

[Bjoerk]

Dann wär es ja doch nicht so schwer, also nur Dank deiner Ausführungen. Ich schau mir den Algo der zip näher an (kann etwas dauern) und teste ein paar Beispiele. Melde mich nochmal.

[Bjoerk]

Ich hab den Code jetzt erst mal auf Standard gebracht. Morgen bau ich ihn noch in meine Software ein. Der Aufbau der InitialMatrix und das Auslesen der SolutionMatrix für meine Software fehlen noch. Melde mich dann nochmal.

Delphi-Quellcode:

unit uCuthillMcKee;

interface

uses
  SysUtils, Dialogs, Classes, Contnrs;

type
  TSymmetricMatrix = class
  private
    FItems: array of array of integer;
    function GetCount: integer;
    procedure SetCount(const Value: integer);
    function GetItems(Row, Col: integer): integer;
    procedure SetItems(Row, Col: integer; const Value: integer);
  public
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
    procedure Clear;
    property Count: integer read GetCount write SetCount;
    property Items[Row, Col: integer]: integer read GetItems write SetItems; default;
    destructor Destroy; override;
  end;

  TIntVector = class
  private
    FItems: array of integer;
    function GetCount: integer;
    procedure SetCount(const Value: integer);
    function GetItems(Index: integer): integer;
    procedure SetItems(Index: integer; const Value: integer);
  public
    procedure Clear;
    function Add(const Value: integer): integer;
    function AsString: string;
    property Count: integer read GetCount write SetCount;
    property Items[Index: integer]: integer read GetItems write SetItems; default;
    destructor Destroy; override;
  end;

  TCuthillMcKeeNode = class
  private
    FInitialLabel: integer;
    FNewLabel: integer;
    FNeighbours: TIntVector;
  public
    procedure Clear;
    property InitialLabel: integer read FInitialLabel write FInitialLabel;
    property NewLabel: integer read FNewLabel write FNewLabel;
    property Neighbours: TIntVector read FNeighbours;
    constructor Create;
    destructor Destroy; override;
  end;

  TCuthillMcKeeNodes = class
  private
    FItems: TObjectList;
    function GetItems(Index: integer): TCuthillMcKeeNode;
    function GetCount: integer;
    procedure SetCount(const Value: integer);
  public
    procedure Clear;
    property Items[Index: integer]: TCuthillMcKeeNode read GetItems; default;
    property Count: integer read GetCount write SetCount;
    constructor Create;
    destructor Destroy; override;
  end;

  TCuthillMcKee = class
  private
    FInitialMatrix: TSymmetricMatrix;
    FSolutionMatrix: TSymmetricMatrix;
    FSolution: TIntVector;
    procedure GenerateSolutionMatrix;
  public
    procedure Clear;
    procedure BandwidthReduction;
    property InitialMatrix: TSymmetricMatrix read FInitialMatrix;
    property SolutionMatrix: TSymmetricMatrix read FSolutionMatrix;
    property Solution: TIntVector read FSolution;
    constructor Create;
    destructor Destroy; override;
  end;

implementation

{ TSymmetricMatrix }

destructor TSymmetricMatrix.Destroy;
begin
  Clear;
  inherited;
end;

procedure TSymmetricMatrix.Clear;
begin
  SetLength(FItems, 0);
end;

function TSymmetricMatrix.GetCount: integer;
begin
  Result := Length(FItems);
end;

procedure TSymmetricMatrix.SetCount(const Value: integer);
begin
  SetLength(FItems, Value, Value);
end;

function TSymmetricMatrix.GetItems(Row, Col: integer): integer;
begin
  Result := FItems[Row, Col];
end;

procedure TSymmetricMatrix.SetItems(Row, Col: integer; const Value: integer);
begin
  FItems[Row, Col] := Value;
end;

procedure TSymmetricMatrix.LoadFromFile(const FileName: string);
var
  F: TextFile;
  N, I, J: integer;
begin
  AssignFile(F, FileName);
  Reset(F);
  Readln(F, N);
  Count := N;
  for I := 0 to Count - 1 do
  begin
    for J := 0 to Count - 1 do
      Read(F, FItems[I, J]);
    Readln(F);
  end;
  CloseFile(F);
end;

procedure TSymmetricMatrix.SaveToFile(const FileName: string);
var
  F: TextFile;
  I, J: integer;
begin
  AssignFile(F, FileName);
  Rewrite(F);
  Writeln(F, Count);
  for I := 0 to Count - 1 do
  begin
    for J := 0 to Count - 1 do
      Write(F, FItems[I, J], #32);
    Writeln(F);
  end;
  CloseFile(F);
end;

{ TIntVector }

destructor TIntVector.Destroy;
begin
  Clear;
  inherited;
end;

procedure TIntVector.Clear;
begin
  SetLength(FItems, 0);
end;

function TIntVector.GetCount: integer;
begin
  Result := Length(FItems);
end;

procedure TIntVector.SetCount(const Value: integer);
begin
  SetLength(FItems, Value);
end;

function TIntVector.GetItems(Index: integer): integer;
begin
  Result := FItems[Index];
end;

procedure TIntVector.SetItems(Index: integer; const Value: integer);
begin
  FItems[Index] := Value;
end;

function TIntVector.Add(const Value: integer): integer;
begin
  Result := Count;
  Count := Result + 1;
  FItems[Result] := Value;
end;

function TIntVector.AsString: string;
var
  I: integer;
begin
  Result := '';
  for I := 0 to Count - 1 do
    Result := Result + Format('%d ', [FItems[I]]);
end;

{ TCuthillMcKeeNode }

constructor TCuthillMcKeeNode.Create;
begin
  FNeighbours := TIntVector.Create;
end;

destructor TCuthillMcKeeNode.Destroy;
begin
  FNeighbours.Free;
  inherited;
end;

procedure TCuthillMcKeeNode.Clear;
begin
  FNeighbours.Clear;
end;

{ TCuthillMcKeeNodes }

constructor TCuthillMcKeeNodes.Create;
begin
  FItems := TObjectList.Create;
end;

destructor TCuthillMcKeeNodes.Destroy;
begin
  FItems.Free;
  inherited;
end;

procedure TCuthillMcKeeNodes.Clear;
begin
  FItems.Clear;
end;

function TCuthillMcKeeNodes.GetCount: integer;
begin
  Result := FItems.Count;
end;

procedure TCuthillMcKeeNodes.SetCount(const Value: integer);
var
  I, N: integer;
begin
  N := Count;
  if Value > Count then
    for I := N to Value - 1 do
      FItems.Add(TCuthillMcKeeNode.Create)
  else
    if Value < Count then
      for I := N - 1 downto Value do
        FItems.Delete(I);
end;

function TCuthillMcKeeNodes.GetItems(Index: integer): TCuthillMcKeeNode;
begin
  Result := TCuthillMcKeeNode(FItems[Index]);
end;

{ TCuthillMcKee }

constructor TCuthillMcKee.Create;
begin
  FInitialMatrix := TSymmetricMatrix.Create;
  FSolutionMatrix := TSymmetricMatrix.Create;
  FSolution := TIntVector.Create;
end;

destructor TCuthillMcKee.Destroy;
begin
  Clear;
  FInitialMatrix.Free;
  FSolutionMatrix.Free;
  FSolution.Free;
  inherited;
end;

procedure TCuthillMcKee.Clear;
begin
  FInitialMatrix.Clear;
  FSolutionMatrix.Clear;
  FSolution.Clear;
end;

procedure TCuthillMcKee.GenerateSolutionMatrix;
var
  I, J: integer;
begin
  FSolutionMatrix.Count := FInitialMatrix.Count;
  for I := 0 to FSolutionMatrix.Count - 1 do
    for J := 0 to FSolutionMatrix.Count - 1 do
      FSolutionMatrix[I, J] := 0;
  for I := 0 to FSolutionMatrix.Count - 1 do
    FSolutionMatrix[I, I] := 1;
end;

procedure TCuthillMcKee.BandwidthReduction;
var
  Nodes: TCuthillMcKeeNodes;
  Selected: TIntVector;
  N, I, J, K, MinCount, MinIndex, A, B: integer;
  UnConnected: boolean;
begin
  Nodes := TCuthillMcKeeNodes.Create;
  Selected := TIntVector.Create;
  try
    N := FInitialMatrix.Count;
    Nodes.Count := N;
    Selected.Count := N;
    FSolution.Count := N;

    for I := 0 to N - 1 do
    begin
      Nodes[I].InitialLabel := I;
      Nodes[I].NewLabel := 0;
      Selected[I] := 0;
      FSolution[I] := -1;
      for J := I + 1 to N - 1 do
        if FInitialMatrix[I, J] <> 0 then
        begin
          Nodes[I].Neighbours.Add(J);
          Nodes[J].Neighbours.Add(I);
        end;
    end;

    MinCount := N;
    MinIndex := -1;
    for I := 0 to N - 1 do
    begin
      for J := 0 to Nodes[I].Neighbours.Count - 2 do
        for K := J + 1 to Nodes[I].Neighbours.Count - 1 do
        begin
          A := Nodes[I].Neighbours[J];
          B := Nodes[I].Neighbours[K];
          if Nodes[A].Neighbours.Count > Nodes[B].Neighbours.Count then
          begin
            Nodes[I].Neighbours[J] := B;
            Nodes[I].Neighbours[K] := A;
          end;
        end;
      if Nodes[I].Neighbours.Count < MinCount then
      begin
        MinCount := Nodes[I].Neighbours.Count;
        MinIndex := I;
      end;
    end;

    A := 0;
    B := 0;
    Selected[MinIndex] := 1;
    FSolution[A] := MinIndex;
    Inc(B);
    Nodes[MinIndex].NewLabel := A;
    repeat
      UnConnected := false;
      while B < N do
      begin
        for I := 0 to Nodes[FSolution[A]].Neighbours.Count - 1 do
          if Selected[Nodes[FSolution[A]].Neighbours[I]] = 0 then
          begin
            Selected[Nodes[FSolution[A]].Neighbours[I]] := 1;
            Inc(B);
            Nodes[Nodes[FSolution[A]].Neighbours[I]].NewLabel := B - 1;
            FSolution[B - 1] := Nodes[FSolution[A]].Neighbours[I];
          end;
        Inc(A);
        if A >= B then
        begin
          UnConnected := true;
          Break;
        end;
      end;
      if UnConnected then
      begin
        MinIndex := -1;
        MinCount := N;
        for I := 0 to N - 1 do
        begin
          if Selected[Nodes[I].InitialLabel] = 0 then
            if Nodes[I].Neighbours.Count < MinCount then
            begin
              MinCount := Nodes[I].Neighbours.Count;
              MinIndex := I;
            end;
        end;
        FSolution[A] := MinIndex;
        Inc(B);
        Nodes[MinIndex].NewLabel := A;
        Selected[MinIndex] := 1;
      end;
    until not UnConnected;

    GenerateSolutionMatrix;
    for I := 0 to N - 1 do
      for J := 0 to Nodes[I].Neighbours.Count - 1 do
      begin
        Nodes[I].Neighbours[J] := Nodes[Nodes[I].Neighbours[J]].NewLabel;
        FSolutionMatrix[Nodes[I].NewLabel, Nodes[I].Neighbours[J]] := 1;
      end;
  finally
    Nodes.Free;
    Selected.Free;
  end;
end;

end.

[Luckie]

Wofür programmierst du denn ein Statikprogramm? Lohnt sich das denn? Es gibt doch auf dem Markt bestimmt schon genug davon? Hinzukommt, wenn es keine reine Spielerei sein soll, sondern ernsthaft eingesetzt werden soll, muss es ja auch irgendwie geprüft werden. Denn ein kleiner Fehler, kann schwerwiegende Folgen haben. Eine große Verantwortung.

Davon abgesehen könnte ich mir vorstellen, dass die zur Finity Elemente Methode genug Beispiele und Erklärungen zur Programmierung gibt.

[Bjoerk]

Damit verdien' ich (seit ca. 20 Jahren) meine Brötchen.

// Edit:
Robert, ich bekomm als Ergebnis immer meinen Input? Kann das sein daß der Algo nicht richtig funzt bzw. die Elemente nicht die Kanten sind? Als Ergebnis müßte hier 1 2 3 4 5 o.ä. rauskommen, also ein Knotenabstand von 1.

[Jens01]

@Luckie
-schlaues Kerlchen..
-das Ganze ist gerade im Umbruch...

@Bjoerk
haste ne neue Homepage

[BUG]

Zitat von Bjoerk:

Kann das sein daß der Algo nicht richtig funzt bzw. die Elemente nicht die Kanten sind? Als Ergebnis müßte hier 1 2 3 4 5 o.ä. rauskommen, also ein Knotenabstand von 1.

Ich habe leider keine Delphi/Lazarus installiert, kann es also nicht ausprobieren.

Vielleicht kannst du mal die Zwischenergebnisse und Ergebnis für eine (nicht optimale) Beispielmatrix ausgeben, also für jeden Schritt jeweils den aktuell den betrachteten Knoten, dessen Nachbarn (altes Label), usw.

[Bjoerk]

Kommando zurück, ist doch korrekt. Sorry. Ich habe die Ergebnisse falsch interpretiert. Die neuen Knotennummern liegen ja auf NewLabel. Die Solutionmatrix brauch ich gar nicht, die stimmt aber auch.

Code:

1 1 0 0 0 
1 1 1 0 0 
0 1 1 1 0 
0 0 1 1 1 
0 0 0 1 1

Nochmals mega Thanx für deine Unterstützung, es läuft jetzt.

Jens, Ja, man muß was tun, wenn MB ihr Zeugs für 99 Euro verramschen. Die entwickeln sich langsam zur Landplage. Mein Vertrieb hat mir schon empfohlen "wir müssen irgendwie an die Architekten ran".