Bandbreitenoptimierung für Matrizen

[Bjoerk]

Ich habe eine Indextabelle (IndexOfU), die folgendermaßen aufgebaut wird:

Delphi-Quellcode:

procedure TFrame.GrowNU(const Index: integer); // Anzahl Unbekannte;
begin
  Inc(FNU);
  FIndexOfU[Index] := FNU;
end;

procedure TFrame.GrowNV(const Index: integer); // Anzahl Auflagergleichungen;
begin
  FIndexOfU[Index] := FN - FNV; // N = DG * Nodes.Count;
  Inc(FNV);
end;

procedure TFrame.CalcIndexOfU;
var
  I, J, Index: integer;
begin
  for I := 1 to FNodes.Count do
    for J := 1 to FDG do // Ebenes Stabwerk 3, Räumliches 6, Ebenes Fachwerk 2, Räumliches 3;
    begin
      Index := FDG * (I - 1) + J;
      if J = 1 then
        if not FNodes.Item[I].Fest.vX then
          GrowNU(Index)
        else
          GrowNV(Index);
      if J = 2 then
        if not FNodes.Item[I].Fest.vY then
          GrowNU(Index)
        else
          GrowNV(Index);
      if FD = 3 then // Räumlich;
      begin
        if J = 3 then
          if not FNodes.Item[I].Fest.vZ then
            GrowNU(Index)
          else
            GrowNV(Index);
        if not FSyst then // Stabwerk;
        begin
          if J = 4 then
            if not FNodes.Item[I].Fest.pX then
              GrowNU(Index)
            else
              GrowNV(Index);
          if J = 5 then
            if not FNodes.Item[I].Fest.pY then
              GrowNU(Index)
            else
              GrowNV(Index);
          if J = 6 then
            if not FNodes.Item[I].Fest.pZ then
              GrowNU(Index)
            else
              GrowNV(Index);
        end;
      end
      else
        if not FSyst and (J = 3) then // Ebenes StabwerK;
        begin
          if not FNodes.Item[I].Fest.pZ then
            GrowNU(Index)
          else
            GrowNV(Index);
        end;
    end;
end;

Nun soll IndexOfU im Bereich 1..NU so "gemischt" werden, so daß NB möglichst klein wird.

Delphi-Quellcode:

procedure TFrame.SimulateLoad(const T1, T2: integer);
var
  k1, k2, i1, i2, Row, Col: integer;
begin
  i1 := FDG * (T1 - 1);
  i2 := FDG * (T2 - 1);
  for k1 := 1 to FDG do
  begin
    Row := FIndexOfU[i1 + k1];
    if Row <= FNU then
      for k2 := 1 to FDG do
      begin
        Col := FIndexOfU[i2 + k2];
        if (Col >= Row) and (Col <= FNU) then
          FNB := Max(FNB, Col - Row + 1);
      end;
  end;
end;

procedure TFrame.CalcNB; // Bandbreite;
var
  I: integer;
begin
  FNB := 0;
  repeat ***
    FIndexOfU := ..
    for I := 1 to FElements.Count do
    begin
      SimulateLoad(FElements.Item[I].Left, FElements.Item[I].Left);
      SimulateLoad(FElements.Item[I].Right, FElements.Item[I].Right);
      SimulateLoad(FElements.Item[I].Left, FElements.Item[I].Right);
      SimulateLoad(FElements.Item[I].Right, FElements.Item[I].Left);
    end;
  until FB möglichst klein; ***
end;

Verstanden was ich meine? Kennt jemand ein Prinzip, nach welchem man NB iterieren könnte (außer Zufallslisten)? BTW, bitte nicht wundern, ist alles 1 basiert.

[Dejan Vu]

Vermutlich bin ich der Einzige, der das nicht verstanden hat. Es geht ja um irgendwelche Gleichungen, Stabwerke, Fachwerke, Ebenen, Räume oder irgendwie so.

Gibt es eine Möglichkeit, das so zu erklären, das man das versteht? Wenn es nämlich um Optimierungen geht, könnte sich das Problem auf eines der Standardprobleme reduzieren, für die es fertige Lösungen gibt.

[BUG]

Zitat:

Zitat von Dejan Vu (Beitrag 1306200)

Vermutlich bin ich der Einzige, der das nicht verstanden hat.

Nope :stupid: Vermutlich wäre es auch hilfreich zu wissen, was NB, NV, NU, usw... bedeuten.

[frankyboy1974]

Hallo,

ich hab das Ausgangsproblem leider auch nicht verstanden, wenn ich aber etwas von Optimierung und Zufallslisten lese, würden mir spontan Evolutionäre Algorithmen einfallen. Ist nur mal so in den Raum geworfen.

mfg

Frank

[TheMiller]

Moin!

Nennt mich jetzt ruhig "kleinlich", aber ein "Hallo; Bitte; Danke; (Tschüss)" wäre auch noch ganz nett, wenn man möchte, dass einem geholfen wird. ( Nicht böse gemeint, also nicht sauer sein :wink: )

[bcvs]

Ich habe das in etwa verstanden (wir kommen aus der selben Branche, wobei das ja eher ein allgemeines mathematisches Problem ist)

Nochmal zum Verständnis:

Delphi-Quellcode:

procedure TFrame.CalcNB; // Bandbreite;
var
  I: integer;
begin
  FNB := 0;
  repeat ***
    FIndexOfU := .. 
    for I := 1 to FElements.Count do
    begin
      SimulateLoad(FElements.Item[I].Left, FElements.Item[I].Left);
      SimulateLoad(FElements.Item[I].Right, FElements.Item[I].Right);
      SimulateLoad(FElements.Item[I].Left, FElements.Item[I].Right);
      SimulateLoad(FElements.Item[I].Right, FElements.Item[I].Left);
    end;
  until FB möglichst klein; ***
end;

Ich nehme an, bei

Delphi-Quellcode:

FIndexOfU :=

soll die Indextabelle in einer geänderten Reigenfolge neu aufgebaut werden. Passiert das durch Aufruf von CalcIndexOfU? Dann könnte man dort vielleicht nicht mit for I := 1 to FNodes.Count über die Nodes laufen, sondern immer möglichst benachbarte Nodes als nächstes einsetzen.

Ansonsten ist auch die Frage, ob die Rechenzeit, die man in eine aufwändige Bandbreitenoptimierung reinsteckt, später bei der eigentlichen Martixberechnung wieder reingeholt wird.

[Rollo62]

Ich verstehe zwar auch nichts, zumal die Struktur der Nodes unklar sind.

Aber wenn es um Performance geht wäre es nicht vielleicht sinnvoll alles in Key/Value Hash-Tabellen umzuprogrammieren
http://docwiki.embarcadero.com/Libra...ns.TDictionary
(

Rollo

[BUG]

Ok, das hat mich jetzt doch interessiert und ich habe mich etwas eingelesen: Es geht darum die Breite des Bandes einer Bandmatrix zu minimieren.

Imho würde sich ein Branch-and-Bound-Verfahren anbieten: Jeden anfügen eines Elemente ist ein Branch-Schritt.
Wenn du das Minimum (oder einen "akzeptablen" Wert) erreicht hast brichst du ab; wenn du irgendwann beim Sortieren die bisherige obere Schranke überschreitest, kannst du den Branch abschneiden: egal wie du den Suffix sortierst, der Zielwert wird nicht besser.

Eine untere Schranke findet man leicht: Die minimale Breite des Bandes ist die maximale Anzahl von Abhängigkeiten eines Elementes.

Dann wäre es natürlich schön, eine möglichst gute erste obere Schranke zu haben.
Das könntest du mit einem Greedy-Verfahren versuchen: Fange mit einem Element mit maximal vielen Abhängigkeiten an, dann füge immer ein Element hinzu, das die älteste Abhängigkeit von Vorgängern erfüllt. Das Ergebnis ist vermutlich nicht optimal, aber vermutlich besser als ausgewürfelt. Alternativ hast du vielleicht Informationen, die du für eine erste Sortierung nutzen kannst, z.B. räumliche Anordnung.

[Bjoerk]

Am besten, ich mach ein Beispiel. Das Beispiel verwendet 5 Knoten und 4 Stäbe. Ein Knoten hat hier 3 Freiheitsgrade, eine Verschiebung in X-Richtung, eine Verschiebung in Y-Richtung und eine Verdrehung in Z-Richtung (Verdrehung um die Z-Achse). Man gibt die Koordinaten der Knoten vor und man gibt Stäbe an.

Ein Stab hat einen linken und einen rechten Anschlußknoten (FElements.Item[I].Left, FElements.Item[I].Right). Hier Stab 1 von Knoten 1 nach Knoten 2, Stab 2 geht von Knoten 2 nach Knoten 5, Stab 3 von Knoten 5 nach Knoten 3 und Stab 4 von Knoten 3 nach Knoten 4.

Dann gibt man an, welche Freiheitsgrade an Knoten ausgeschlossen werden (Auflager). Im Beispiel sind an den Knoten 1, 4 und 5 die Verschiebungen in Y-Richtung ausgeschlossen, am Knoten 5 zusätzlich die Verschiebung in X-Richtung.

Mit diesen Angaben kann man eine Indexliste aufbauen und damit eine Systemsteifigkeitsmatrix aufstellen. Die Indexliste gibt an, daß z.B. die Reihe/Spalte 2 der Matrix nach Reihe/Spalte 15 zu verschieben ist (IndexOfRow, IndexOfCol). Die Matrix ist symmetrisch und hat eine Bandstruktur. Wie groß die Bandbreite ist kann man berechnen.

Delphi-Quellcode:

procedure TFrame.SimulateLoad(const T1, T2: integer);
var
  k1, k2, i1, i2, Row, Col: integer;
begin
  i1 := FDG * (T1 - 1);
  i2 := FDG * (T2 - 1);
  for k1 := 1 to FDG do
  begin
    Row := FIndexOfU[i1 + k1];
    if Row <= FNU then
      for k2 := 1 to FDG do
      begin
        Col := FIndexOfU[i2 + k2];
        if (Col >= Row) and (Col <= FNU) then
          FNB := Max(FNB, Col - Row + 1);
      end;
  end;
end;

procedure TFrame.CalcNB; // Bandbreite;
var
  I: integer;
begin
  FNB := 0;
  for I := 1 to FElements.Count do
  begin
    SimulateLoad(FElements.Item[I].Left, FElements.Item[I].Left);
    SimulateLoad(FElements.Item[I].Right, FElements.Item[I].Right);
    SimulateLoad(FElements.Item[I].Left, FElements.Item[I].Right);
    SimulateLoad(FElements.Item[I].Right, FElements.Item[I].Left);
  end;
end;

Um die Bandbreite zu optimieren, benennt man die Knoten lediglich anders. Lisa heißt jetzt Petra und Petra Lisa. Damit ergibt sich eine andere Indexliste und eine andere Bandbreite. Man tauscht z.B. die Namen der Knoten von 1 und 5. Damit geht Stab 1 nicht mehr von Knoten 1 nach Knoten 2 sondern von Knoten 5 nach Knoten 2. Mit dieser Knotenbenennung durchläuft man den Algo nochmals. Gesucht ist die Knotenbenennung, die die kleinste Bandbreite ergibt.

[BUG]

Wenn ich das richtig verstanden habe, ist das Aufbauen der Indexliste (=> Permutation) quasi das Sortieren der Elemente/Knoten so dass die Bandbreite minimal wird?

[Bjoerk]

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

[BUG]

Zitat:

Zitat von Bjoerk (Beitrag 1306249)

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 :mrgreen:

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 :stupid: :mrgreen:

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:

Zitat von Bjoerk (Beitrag 1306434)

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. :thumb: 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...8-)

@Bjoerk
haste ne neue Homepage

[BUG]

Zitat:

Zitat von Bjoerk (Beitrag 1306535)

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. :-D

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

[BUG]

Zitat:

Zitat von Bjoerk (Beitrag 1306585)

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

Super, freut mich immer wenn Leute algorithmische Probleme lösen wollen und nicht nur Daten hin und her konvertieren :mrgreen:
Andere Algorithmen haben vielleicht noch bessere Ergebnisse und so richtig toll finde ich den Stil der Implementierung nicht, aber den Einstieg hast du jetzt ja.

[Jens01]

Zitat:

Jens, Ja, man muß was tun, wenn MB ihr Zeugs für 99 Euro verramschen.

Für 98 anbieten! Mit vielen Bugs drin und dann Maintenance verkaufen.

[Bjoerk]

Robert, das bringt echt unheimlich viel. Beispiel Kreis (als N-Eck), kommt öfter mal vor. Den gibt man bequemerweise meistens so ein:

Code:

Line 1: Node 1 - Node 2
Line 2: Node 2 - Node 3
Line 3: Node 3 - Node 4
Line 4: Node 4 - Node 5
Line 5: Node 5 - Node 6
Line 6: Node 6 - Node 7
Line 7: Node 7 - Node 8
Line 8: Node 8 - Node 9
Line 9: Node 9 - Node 10
Line 10: Node 10 - Node 11
Line 11: Node 11 - Node 12
Line 12: Node 12 - Node 13
Line 13: Node 13 - Node 14
Line 14: Node 14 - Node 15
Line 15: Node 15 - Node 16
Line 16: Node 16 - Node 17
Line 17: Node 17 - Node 18
Line 18: Node 18 - Node 19
Line 19: Node 19 - Node 20
Line 20: Node 20 - Node 21
Line 21: Node 21 - Node 1

NodesCount = 21
InitialBandwidth = 20 x degree of freedom

Rename Node 3 -> To 4
Rename Node 4 -> To 6
Rename Node 5 -> To 8
Rename Node 6 -> To 10
Rename Node 7 -> To 12
Rename Node 8 -> To 14
Rename Node 9 -> To 16
Rename Node 10 -> To 18
Rename Node 11 -> To 20
Rename Node 12 -> To 21
Rename Node 13 -> To 19
Rename Node 14 -> To 17
Rename Node 16 -> To 13
Rename Node 17 -> To 11
Rename Node 18 -> To 9
Rename Node 19 -> To 7
Rename Node 20 -> To 5
Rename Node 21 -> To 3
SolutionBandwidth = 2 x degree of freedom

Jens, hast du jemals den Staatsanwalt auf der Baustelle rumlaufen sehen? Mit solchen Sprüchen wär' ich generell vorsichtig. Bei Vorsatz zahlt keine Haftpflichtversicherung. Und daß es meine Software ausschließlich mit Software Service Vertrag gibt solltest du langsam wissen? Du bringst mich aber auf eine Idee. Ich könnte sie (deswegen) tatsächlich sogar für 1 Euro verticken. Ich red' mal mit dem Vertrieb darüber (die wollen ja trotzdem Ihre Kohle).

[Jens01]

Zitat:

Jens, hast du jemals den Staatsanwalt auf der Baustelle rumlaufen sehen? Mit solchen Sprüchen wär' ich generell vorsichtig. Bei Vorsatz zahlt keine Haftpflichtversicherung. Und daß es meine Software ausschließlich mit Software Service Vertrag gibt solltest du langsam wissen? Du bringst mich aber auf eine Idee. Ich könnte sie (deswegen) tatsächlich sogar für 1 Euro verticken. Ich red' mal mit dem Vertrieb darüber (die wollen ja trotzdem Ihre Kohle).

Meine Aussage war Ironie gepaart mit einer herben Kritik an eine amerikanische Softwarefirma!
Keine Aufforderung zum Einbauen von Bugs.
Obgleich ich der Meinung bin, dass solche Software (wie Deine) nur über ein Maintenance-Vertrag verkauft werden kann. Das steht aber entgegen einem Standalone-Produkt, welches nach meinem Erachten fehlerfrei sein muss. Bzw ein Verpflichtung auf Nachbesserung besteht.

[Bjoerk]

Ein komplexes Softwareprodukt ohne Fehler zu erstellen ist nicht möglich. Mein Software Service Vertrag beinhaltet neben allen Updates deshalb natürlich auch die Wartung. Wenn ich in meinem Lizenzbedingen schreibe, daß die Software durch wirksame Kontrollmaßnahen geprüft wurde, dann ist das auch so. Das Stabwerk z.B. wurde mit dem Star2/ Star3 von Fides (heute Sofistik) gegengerechnet. Kannst meine Software gerne kaufen und testen. Für jeden Fehler den du findest zahl ich dir 50 Euro.

[Jens01]

Du nutzt also die Tests von einem anderen Produkt!? :gruebel:
P.S.: Wenn die ihr Produkt nicht testen, ist Deins auch nicht getestet; wenn die Bugs im System haben, dann hast Du sie auch.

[Bjoerk]

Durch den Kontakt zu meinen Kunden (sind auch so 30 Prüfingenieure darunter) oder zu zwei Statik-Profs (die ich gelegentlich um Rat frage) oder durch Gespräche auf Fachseminaren (meistens an der TU Karlsruhe) weiß ich eigentlich ganz gut Bescheid. Das Star2/ Star3 von Sofistik und übrigens auch der DLT9 von Friedrich & Lochner wurden stets als äußerst zuverlässig eingestuft. Anyway. Kein Bock mehr. Schönes WE.

[Jens01]

Sorry, sollte keine zu herbe Kritik sein.
Deine Produkte werden schon gut funktionieren, bis dahin.