[Mathematik] Suche Vektoren für Körper

[Bjoerk]

Exklusiv für die DP von DOS Basic nach Delphi gestern umgeschrieben.

Nicht groß getestet, sollte aber funktionieren.

Delphi-Quellcode:

unit uPolyeder; // (c) 28.04.1985, 2.05.2012 Thomas Abel, Edgar Zocher

interface

uses
  SysUtils, Dialogs;

const
  MaxPoints = 500; // NEck (Sprich N-Eck), Polyeder
  MaxBegrenzungsEbenen = 50; // Polyeder
  MaxPointsJeBegrenzungsEbene = 20; // Polyeder

type
  TD2Point = record
    X, Y: double;
  end;
  TD2Points = array [0..MaxPoints] of TD2Point; // Siehe auch CloseNEck

  TNEck = class
  private
    FCount: integer; // Anzahl der Punkte
    FPoints: TD2Points;
    function Determinante(const I: integer): double;
    procedure CloseNEck;
    function GetPoint(Index: integer): TD2Point;
    procedure SetPoint(const Index: integer; const X, Y: double);
    procedure PutPoint(Index: integer; const Value: TD2Point);
  public
    property Points[Index: integer]: TD2Point read GetPoint write PutPoint;
    property Count: integer read FCount;
    procedure Clear;
    procedure AddPoint(const X, Y: double); overload;
    procedure AddPoint(const Index: integer); overload;
    procedure DelPoint(const Index: integer);
    procedure InsPoint(const Index: integer; const X, Y: double);
    function Schwerpunkt: TD2Point;
    function Flaeche: double;
    constructor Create;
  end;

  TD3Point = record
    X, Y, Z: double;
    Exist: boolean;
  end;
  TD3Points = array [0..MaxPoints - 1] of TD3Point;

  TBegrenzungsEbene = record
    Count: integer;
    PointNumbers: array [0..MaxPointsJeBegrenzungsEbene - 1] of integer;
    procedure AddPointNumber(const Value: integer);
    procedure DelPointNumber(const Index: integer);
    procedure InsPointNumber(const Index, Value: integer);
    procedure Clear;
  end;
  TBegrenzungsEbenen = array [0..MaxBegrenzungsEbenen - 1] of TBegrenzungsEbene;
  TPolyederPoints = array [1..3, 1..3] of double;

  TPolyeder = class
  private
    FN: integer; // Anzahl der BegrenzungsEbenen
    FCount: integer; // Anzahl der Punkte
    FPoints: TD3Points;
    FEbenen: TBegrenzungsEbenen;
    function Determinante(const U, V, W: integer): double;
    function PolyederPoints(const U, V, W: integer): TPolyederPoints;
    function GetBegrenzungsEbene(Index: integer): TBegrenzungsEbene;
    function GetPoint(Index: integer): TD3Point;
    procedure SetPoint(const Index: integer;
      const X, Y, Z: double; const Exist: boolean);
    procedure PutPoint(Index: integer; const Value: TD3Point);
    procedure PutBegrenzungsEbene(Index: integer;
      const Value: TBegrenzungsEbene);
  public
    property Points[Index: integer]: TD3Point read GetPoint write PutPoint;
    property Ebenen[Index: integer]: TBegrenzungsEbene
      read GetBegrenzungsEbene write PutBegrenzungsEbene;
    property Count: integer read FCount;
    property N: integer read FN;
    procedure Clear;
    procedure AddPoint(const X, Y, Z: double);
    procedure DelPoint(const Index: integer);
    procedure InsPoint(const Index: integer; const X, Y, Z: double);
    procedure AddBegrenzungsEbene(const PointNumbers: array of integer);
    procedure DelBegrenzungsEbene(const Index: integer);
    procedure InsBegrenzungsEbene(const Index: integer;
      const PointNumbers: array of integer);
    function Schwerpunkt: TD3Point;
    function Volumen: double;
    constructor Create;
  end;

implementation

{ NEck }

function TNEck.GetPoint(Index: integer): TD2Point;
begin
  Result:= FPoints[Index];
end;

procedure TNEck.PutPoint(Index: integer; const Value: TD2Point);
begin
  FPoints[Index]:= Value;
end;

procedure TNEck.SetPoint(const Index: integer; const X, Y: double);
begin
  FPoints[Index].X:= X;
  FPoints[Index].Y:= Y;
end;

procedure TNEck.AddPoint(const X, Y: double);
begin
  Inc(FCount);
  SetPoint(FCount - 1, X, Y);
end;

procedure TNEck.AddPoint(const Index: integer);
begin
  AddPoint(FPoints[Index].X, FPoints[Index].Y);
end;

procedure TNEck.DelPoint(const Index: integer);
var
  I: integer;
begin
  for I:= Index to FCount - 2 do
    FPoints[I]:= FPoints[I + 1];
  Dec(FCount);
end;

procedure TNEck.InsPoint(const Index: integer; const X, Y: double);
var
  I: integer;
begin
  Inc(FCount);
  for I:= FCount - 1 downto Index + 1 do
    FPoints[I]:= FPoints[I - 1];
  SetPoint(Index, X, Y)
end;

function TNEck.Determinante(const I: integer): double;
begin
  Result:= FPoints[I].X * FPoints[I + 1].Y - FPoints[I].Y * FPoints[I + 1].X;
end;

procedure TNEck.CloseNEck;
begin
  FPoints[FCount].X:= FPoints[0].X;
  FPoints[FCount].Y:= FPoints[0].Y;
end;

function TNEck.Flaeche: double;
var
  I: integer;
begin
  Result:= 0;
  CloseNEck;
  for I:= 0 to FCount - 1 do
    Result:= Result + Determinante(I) / 2;
end;

function TNEck.Schwerpunkt: TD2Point;
var
  I: integer;
begin
  Result.X:= 0;
  Result.Y:= 0;
  CloseNEck;
  for I:= 0 to FCount - 1 do
  begin
    Result.X:= Result.X + (FPoints[I].X + FPoints[I + 1].X) * Determinante(I) / 6;
    Result.Y:= Result.Y + (FPoints[I].Y + FPoints[I + 1].Y) * Determinante(I) / 6;
  end;
  Result.X:= Result.X / Flaeche;
  Result.Y:= Result.Y / Flaeche;
end;

procedure TNEck.Clear;
begin
  FCount:= 0;
end;

constructor TNEck.Create;
begin
  inherited Create;
  Clear;
end;

{ TBegrenzungsEbene }

procedure TBegrenzungsEbene.Clear;
begin
  Count:= 0;
end;

procedure TBegrenzungsEbene.AddPointNumber(const Value: integer);
begin
  Inc(Count);
  PointNumbers[Count - 1]:= Value;
end;

procedure TBegrenzungsEbene.DelPointNumber(const Index: integer);
var
  I: integer;
begin
  for I:= Index to Count - 2 do
    PointNumbers[I]:= PointNumbers[I + 1];
  Dec(Count);
end;

procedure TBegrenzungsEbene.InsPointNumber(const Index, Value: integer);
var
  I: integer;
begin
  Inc(Count);
  for I:= Count - 1 downto Index + 1 do
    PointNumbers[I]:= PointNumbers[I - 1];
  PointNumbers[Index]:= Value;
end;

{ TPolyeder }

function TPolyeder.GetPoint(Index: integer): TD3Point;
begin
  Result:= FPoints[Index];
end;

procedure TPolyeder.PutPoint(Index: integer; const Value: TD3Point);
begin
  FPoints[Index]:= Value;
end;

procedure TPolyeder.SetPoint(const Index: integer;
  const X, Y, Z: double; const Exist: boolean);
begin
  FPoints[Index].X:= X;
  FPoints[Index].Y:= Y;
  FPoints[Index].Z:= Z;
  FPoints[Index].Exist:= Exist;
end;

procedure TPolyeder.AddPoint(const X, Y, Z: double);
begin
  Inc(FCount);
  SetPoint(FCount - 1, X, Y, Z, true);
end;

procedure TPolyeder.DelPoint(const Index: integer);
var
  I: integer;
begin
  for I:= Index to FCount - 2 do
    FPoints[I]:= FPoints[I + 1];
  FPoints[FCount - 1].Exist:= false;
  Dec(FCount);
end;

procedure TPolyeder.InsPoint(const Index: integer; const X, Y, Z: double);
var
  I: integer;
begin
  Inc(FCount);
  for I:= FCount - 1 downto Index + 1 do
    FPoints[I]:= FPoints[I - 1];
  SetPoint(Index, X, Y, Z, true);
end;

function TPolyeder.GetBegrenzungsEbene(Index: integer): TBegrenzungsEbene;
begin
  Result:= FEbenen[Index];
end;

procedure TPolyeder.PutBegrenzungsEbene(Index: integer;
  const Value: TBegrenzungsEbene);
begin
  FEbenen[Index]:= Value;
end;

procedure TPolyeder.AddBegrenzungsEbene(const PointNumbers: array of integer);
var
  I: integer;
begin
  Inc(FN);
  for I:= 0 to Length(PointNumbers) - 1 do
    FEbenen[FN - 1].AddPointNumber(PointNumbers[I]);
end;

procedure TPolyeder.DelBegrenzungsEbene(const Index: integer);
var
  I: integer;
begin
  for I:= Index to FN - 2 do
    FEbenen[I]:= FEbenen[I + 1];
  Dec(FN);
end;

procedure TPolyeder.InsBegrenzungsEbene(const Index: integer;
  const PointNumbers: array of integer);
var
  I: integer;
  Value: TBegrenzungsEbene;
begin
  Value.Clear;
  for I:= 0 to Length(PointNumbers) - 1 do
    Value.AddPointNumber(PointNumbers[I]);
  Inc(FN);
  for I:= FN - 1 downto Index + 1 do
    FEbenen[I]:= FEbenen[I - 1];
  FEbenen[Index]:= Value;
end;

function TPolyeder.PolyederPoints(const U, V, W: integer): TPolyederPoints;
begin
  if not FPoints[U].Exist then
    raise Exception.Create('Punkt '+IntToStr(U) + ' existiert nicht.');
  if not FPoints[V].Exist then
    raise Exception.Create('Punkt '+IntToStr(V) + ' existiert nicht.');
  if not FPoints[W].Exist then
    raise Exception.Create('Punkt '+IntToStr(W) + ' existiert nicht.');
  Result[1, 1]:= FPoints[U].X;
  Result[2, 1]:= FPoints[U].Y;
  Result[3, 1]:= FPoints[U].Z;
  Result[1, 2]:= FPoints[V].X;
  Result[2, 2]:= FPoints[V].Y;
  Result[3, 2]:= FPoints[V].Z;
  Result[1, 3]:= FPoints[W].X;
  Result[2, 3]:= FPoints[W].Y;
  Result[3, 3]:= FPoints[W].Z;
end;

function TPolyeder.Determinante(const U, V, W: integer): double;
var
  P: TPolyederPoints;
begin
  P:= PolyederPoints(U, V, W);
  Result:= P[1, 1] * (P[2, 2] * P[3, 3] - P[3, 2] * P[2, 3])
    - P[2, 1] * (P[1, 2] * P[3, 3] - P[3, 2] * P[1, 3])
    + P[3, 1] * (P[1, 2] * P[2, 3] - P[2, 2] * P[1, 3]);
end;

function TPolyeder.Volumen: double;
var
  I, J, U, V, W: integer;
  E: TBegrenzungsEbene;
begin
  Result:= 0;
  for I:= 0 to FN - 1 do
  begin
    E:= FEbenen[I];
    U:= E.PointNumbers[0];
    V:= E.PointNumbers[1];
    for J:= 2 to E.Count - 1 do
    begin
      W:= E.PointNumbers[J];
      Result:= Result + Determinante(U, V, W) / 6;
      V:= W;
    end;
  end;
end;

function TPolyeder.Schwerpunkt: TD3Point;
var
  I, J, U, V, W, k1, k2: integer;
  E: TBegrenzungsEbene;
  M: array [1..3] of double;
  T: double;
  P: TPolyederPoints;
begin
  for k1:= 1 to 3 do
    M[k1]:= 0;
  for I:= 0 to FN - 1 do
  begin
    E:= FEbenen[I];
    U:= E.PointNumbers[0];
    V:= E.PointNumbers[1];
    for J:= 2 to E.Count - 1 do
    begin
      W:= E.PointNumbers[J];
      P:= PolyederPoints(U, V, W);
      for k1:= 1 to 3 do
      begin
        T:= 0;
        for k2:= 1 to 3 do
          T:= T + P[k1, k2];
        M[k1]:= M[k1] + Determinante(U, V, W) / 24 * T;
      end;
      V:= W;
    end;
  end;
  Result.X:= M[1] / Volumen;
  Result.Y:= M[2] / Volumen;
  Result.Z:= M[3] / Volumen;
end;

procedure TPolyeder.Clear;
var
  I: integer;
begin
  FCount:= 0;
  FN:= 0;
  for I:= 0 to MaxBegrenzungsEbenen - 1 do
    FEbenen[I].Clear;
  for I:= 0 to MaxPoints - 1 do
    FPoints[I].Exist:= false;
end;

constructor TPolyeder.Create;
begin
  inherited Create;
  Clear;
end;

end.

Delphi-Quellcode:

unit PolyederUnit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, uPolyeder;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  ANEck: TNEck;
begin
  ANEck:= TNEck.Create;
  try
    // Vorhandene Flächen mathematisch positiv umfahren
    ANEck.AddPoint(0, 0);
    ANEck.AddPoint(10, 0);
    ANEck.AddPoint(10, 5);
    ANEck.AddPoint(0, 5); // Nr. 3

    // Aussparungen mathematisch negativ umfahren
    ANEck.AddPoint(1, 4); // Nr. 4
    ANEck.AddPoint(9, 4);
    ANEck.AddPoint(9, 1);
    ANEck.AddPoint(1, 1);
    ANEck.AddPoint(4); // Teilfläche schließen
    ANEck.AddPoint(3); // Aussparung schließen

    ShowMessage(FloatToStr(ANEck.Flaeche));

    ShowMessage(FloatToStr(ANEck.Schwerpunkt.X));
    ShowMessage(FloatToStr(ANEck.Schwerpunkt.Y));
  finally
    ANEck.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  APolyeder: TPolyeder;
begin
  APolyeder:= TPolyeder.Create;
  try
    APolyeder.AddPoint(0, 0, 0);
    APolyeder.AddPoint(10, 0, 0);
    APolyeder.AddPoint(10, 5, 0);
    APolyeder.AddPoint(0, 5, 0);
    APolyeder.AddPoint(10, 5, 20);

    // Begrenzungsflächen mathematisch positiv umfahren
    APolyeder.AddBegrenzungsEbene([0, 1, 4]);
    APolyeder.AddBegrenzungsEbene([1, 2, 4]);
    APolyeder.AddBegrenzungsEbene([2, 3, 4]);
    APolyeder.AddBegrenzungsEbene([3, 0, 4]);
    APolyeder.AddBegrenzungsEbene([0, 3, 2, 1]);

    ShowMessage(FloatToStr(APolyeder.Volumen));

    ShowMessage(FloatToStr(APolyeder.Schwerpunkt.X));
    ShowMessage(FloatToStr(APolyeder.Schwerpunkt.Y));
    ShowMessage(FloatToStr(APolyeder.Schwerpunkt.Z));
  finally
    APolyeder.Free;
  end;
end;

end.