Bandbreitenoptimierung für Matrizen

[Bjoerk]

Ja, nur daß es mal leicht 1000 Knoten sein können. Deshalb scheidet Permutation eigentlich aus.

[BUG]

Zitat von Bjoerk:

Deshalb scheidet Permutation eigentlich aus.

Deswegen habe ich ja Branch and Bound vorgeschlagen, wobei hoffentlich viele Zweige schon für kürzere Listen verworfen werden.
Kann natürlich sein, dass das immer noch zu viel ist; das kommt auch auf die erste Schranke an.

EDIT: Hui, ich hab mal nach matrix bandwidth minimization gesucht und da gibt es einiges an Material. Einmal tatsächlich Branch&Bound-Verfahren, aber auch vieles anderes. Lies einfach ein paar der Paper durch, da wirst du schon einen passenden Ansatz finden

EDIT2: Der Cuthill-McKee-Algorithmus scheint gut implementierbar zu sein, ansonsten sieht das ganz interessant aus.

[Bjoerk]

Ja, der letzte Link sieht gut aus. Vielen Dank Robert. Ich denke was man auf jeden Fall sagen kann, daß die Bandbreite proportional dem max. Knotenabstand ist. Mir fällt halt keine "SortByKnotenabstand" ein und einen Baum wollte ich vermeiden (weil ich da keine Plan von hab. )

@Bcvs, bei Stabwerken geht das gerade noch so. Würde das dann aber auch bei meinen FE (Platten/Scheiben) einbauen.

@All, ich hab ALLE Posts gelesen und freue mich über das Interssse. Hab ja deshlab auch das Beispiel angehängt.

[Bjoerk]

Kannst du mir sagen was der Autor hier macht? Und wie ich das ggf. auf mein Problem übertragen kann? Nur falls du Zeit und Lust hast.. In FormCreate ist übrigens Decimalseparator := '.' zu ergänzen.

[BUG]

Auf den ersten Blick: Das Programm testet verschiedene Verfahren zur Bandbreitenreduktion

Zu Cuthill-McKee: Jede symmetrische Matrix entspricht einem Graph, wobei jede Zeile/Spalte einem Knoten entspricht und jeder nicht-null Eintrag einer Kante. Dieser Graph wird in einer günstigeren Datenstruktur gespeichert (Knoten mit Nachbarschaftsliste) um nicht ständig in der Matrix suchen zu müssen. Gerade bei nicht dicht besetzten Matrizen ist das sehr viel günstiger. Dann werden die Knoten des Graphen des Graphen nach Cuthill-McKee sortiert. Diese Sortierung entspricht dann einer Permutation der Matrix, die dann "angewendet" wird.

Zu dem anderen Verfahren kann ich nichts sagen. Sieht auf den ersten Blick aus wie jeder anderer evolutionäre Algorithmus.

EDIT: Hast du den begleiteten Blogpost gelesen?

[Bjoerk]

Ja, hatte ich gelesen. Ich hab aber leider keine Ahnung von solchen Grafen, sprich, wie man die Matrix für den Cuthill-McKee-Algorithmus erstellen muß? Wenn du magst, kannst das anhand des Beispiels von Post # 9 kurz erläutern? Der Input soll rein aus den Linken und Rechten Knotenzuordnungen der Stäbe erfolgen. Das Beispiel verwendet 5 Knoten und 4 Stäbe.

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

Die Löung sollte dann z.B. so aussehen:

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

[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.