135481 (722126), страница 3
Текст из файла (страница 3)
AMatrix.Resize (Pred(AGrid.ColCount), Pred(AGrid.RowCount));
for i := 1 to AMatrix.RowCount do
for j := 1 to AMatrix.ColCount do
begin
if CropStr(AGrid.Cells[j, i]) = '' then AGrid.Cells[j, i] := '0';
AMatrix[j ,i] := StrToFloat(AGrid.Cells[j, i])
end
end;
procedure OutPutMatrixToStrGrd (AMatrix: TMatrix; AGrid: TStringGrid);
var
i, j: Word;
begin
AGrid.ColCount := Succ(AMatrix.ColCount);
AGrid.RowCount := Succ(AMatrix.RowCount);
for i := 1 to AMatrix.RowCount do
for j := 1 to AMatrix.ColCount do
begin
AGrid.Cells[j, 0] := IntToStr (j);
AGrid.Cells[0, i] := IntToStr (i);
AGrid.Cells[j, i] := FloatToStrF(AMatrix[j ,i],ffGeneral,5,3);
end
end;
procedure OutPutMatrixSolveToStrGrd (AMatrix: TMatrix; AGrid: TStringGrid);
var
i, j, k: Word;
begin
AGrid.ColCount := AMatrix.ColCount;
AGrid.RowCount := Succ(AMatrix.RowCount);
for i := 1 to AMatrix.RowCount do
for j := 1 to AMatrix.ColCount do
begin
if j = AMatrix.ColCount then k := 0 else k := j;
AGrid.Cells[j, 0] := 'X' + IntToStr (j);
AGrid.Cells[k, i] := FloatToStrF(AMatrix[j ,i],ffGeneral,5,3);
end;
AGrid.Cells[0, 0] := 'Время';
end;
procedure LoadMatrixSolveFromStrGrd (AMatrix: TMatrix; AGrid: TStringGrid);
var
i, j, k: Word;
begin
AMatrix.Resize (AGrid.ColCount, Pred(AGrid.RowCount));
for i := 1 to AMatrix.RowCount do
for j := 0 to AMatrix.ColCount do
begin
if j = 0 then k := AMatrix.ColCount else k := j;
if CropStr(AGrid.Cells[j, i]) = '' then AGrid.Cells[j, i] := '0';
AMatrix[k ,i] := StrToFloat(AGrid.Cells[j, i])
end
end;
procedure ComputeFromPage0;
var
Order : TOrder;
i, j : byte;
K : ShortInt;
mDummy1, mDummy2,
mA, mB, mKp,
mM, mN, mN1: TMatrix;
cvRoots: TComplexVector;
begin
with Form_Main do
begin
Order := SpinEdit_Dim.Value;
mA := TMatrix.Create(Order, Order);
mB := TMatrix.Create(1, Order);
mM := TMatrix.Create(Order, Order);
mDummy1 := TMatrix.Create(Order, Order);
mN1 := TMatrix.Create(Order, 1);
mN := TMatrix.Create(Order, Order);
mDummy2 := TMatrix.Create(Order, Order);
mKp := TMatrix.Create(Order, 1);
LoadMatrixFromStrGrd (mA, StringGrid_Ap0);
LoadMatrixFromStrGrd (mB, StringGrid_Bp0);
for j := 1 to Order do
begin
mDummy1.Assign(mA);
mDummy1.NthPower(j - 1);
mDummy1.MultFromRight(mB);
for i := 1 to Order do
mM[j, i] := mDummy1[1, i];
end;
if not mM.Inverse then
Raise ESingularMatrix.Create('Система неполностью управляема:' +
'матрица M - вырожденная !!!'#10 +
'Измените значения коэффициентов матриц А и B');
mN1.SetNull;
mN1[Order, 1] := 1;
mN1.MultFromRight(mM);
for i := 1 to Order do
begin
mDummy2.Assign(mA);
mDummy2.NthPower(i-1);
mDummy1.Assign(mN1);
mDummy1.MultFromRight(mDummy2);
for j := 1 to Order do mN[j, i] := mDummy1[j, 1];
end;
mDummy1.Assign(mN);
if not mDummy1.Inverse then
Raise ESingularMatrix.Create('Не могу обратить матрицу N !!!'#10 +
'(не разбрасывайтесь порядками коэффициентов матриц)');
mA.MultFromLeft(mN);
mA.MultFromRight(mDummy1);
OutPutMatrixToStrGrd(mA, StringGrid_Anp0);
cvRoots.Dim := Order;
for j := 1 to Order do
begin
cvRoots.Data[j].Re := StrToFloat(StringGrid_Roots.Cells[j, 1]);
cvRoots.Data[j].Im := StrToFloat(StringGrid_Roots.Cells[j, 2]);
end;
for j := 1 to Order do
begin
if Odd (j) then K := -1 else K := +1;
mKp[Order-Pred(j), 1] := - mA[Order-Pred(j), Order] -
K * SymmetricalFunction(cvRoots, j);
end;
mKp.MultFromRight(mN);
OutPutMatrixToStrGrd (mKp, StringGrid_Kpp0);
mDummy1.Free;
mDummy2.Free;
mA.Free;
mB.Free;
mKp.Free;
mM.Free;
mN.Free;
mN1.Free;
end;
end;
procedure ComputeFromPage1;
var
Order: TOrder;
mA, mB, mABKp, mInCond, mKp: TMatrix;
mSolutionValues: TMatrix;
LowerLimit, UpperLimit, NumReturn, NumIntervals: Word;
begin
with Form_Main do
begin
Order := SpinEdit_Dim.Value;
mA := TMatrix.Create(Order, Order);
mB := TMatrix.Create(1, Order);
mKp := TMatrix.Create(Order, 1);
mInCond := TMatrix.Create(Order, 1);
LoadMatrixFromStrGrd(mA, StringGrid_Ap1);
LoadMatrixFromStrGrd(mB, StringGrid_Bp1);
LoadMatrixFromStrGrd(mKp, StringGrid_Kpp1);
LoadMatrixFromStrGrd(mInCond, StringGrid_InCond);
mABKp := TMatrix.Create(Order, Order);
mABKp.Assign(mB);
mABKp.MultFromRight(mKp);
mABKp.AddMatrix(mA);
OutPutMatrixToStrGrd(mABKp, StringGrid_ABKpp1);
mB.MultConst(StrToFloat(Edit_U.Text));
with Form_Options do
begin
LowerLimit := SpinEdit0.Value;
UpperLimit := SpinEdit1.Value;
NumReturn := SpinEdit2.Value;
NumIntervals := SpinEdit3.Value;
end;
mSolutionValues := TMatrix.Create(1, 1);
try
DiffSystemSolve (mA, mB,
LowerLimit, UpperLimit,
mInCond,
NumReturn, NumIntervals,
mSolutionValues);
OutPutMatrixSolveToStrGrd(mSolutionValues, StringGrid_Solve1);
mSolutionValues.ReSize(1, 1);
DiffSystemSolve (mABKp, mB,
LowerLimit, UpperLimit,
mInCond,
NumReturn, NumIntervals,
mSolutionValues);
OutPutMatrixSolveToStrGrd(mSolutionValues, StringGrid_Solve2);
except
on EO: EOverflow do
begin
EO.Message := 'Не буду считать !!!'#10 +
'С уменьшите разброс коэффициентов в матрицах'#10 +
'либо измените опции (уменьшите их pls.)';
Raise;
end;
end;
mA.Free;
mB.Free;
mABKp.Free;
mInCond.Free;
mKp.Free;
mSolutionValues.Free;
end;
end;
procedure ShowChart(NumberOfChart: Byte);
var
Order, Serie: TOrder;
NumReturn, Point: Word;
mSolutionValues: TMatrix;
procedure SetAdm;
const
Divisor = 3.4E+38;
var
i, j: LongInt;
Greatest, Least: Float;
begin
Greatest := mSolutionValues[1, 1];
Least := Greatest;
for j := 1 to Order do
for i := 1 to NumReturn do
begin
if mSolutionValues[j, i] > Greatest then Greatest := mSolutionValues[j, i];
if mSolutionValues[j, i] < Least then Least := mSolutionValues[j, i];
end;
Form_Main.ChartFX.Adm[CSA_MAX] := Greatest;
Form_Main.ChartFX.Adm[CSA_MIN] := Least;
Form_Main.ChartFX.Title[CHART_TOPTIT] := 'Y = Y '' * ';
end;
begin
with Form_Main do
begin
Order := SpinEdit_Dim.Value;
NumReturn := Form_Options.SpinEdit2.Value;
mSolutionValues := TMatrix.Create(1, 1);
ComputeFromPage1;
case NumberOfChart of
1 :begin
LoadMatrixSolveFromStrGrd(mSolutionValues, StringGrid_Solve1);
SetAdm;
ChartFX.OpenDataEx(Cod_Values, Order, Pred(NumReturn));
for Serie := 1 to Order do
begin
ChartFX.SerLeg[Pred(Serie)] := 'X ' + IntToStr(Serie);
ChartFX.ThisSerie := Pred(Serie);
for Point := 0 to Pred(NumReturn) do
ChartFX.Value[Point] := mSolutionValues[Serie, Succ(Point)];
end;
ChartFX.CloseData(Cod_Values);
{
ChartFX.OpenDataEx(Cod_XValues, Order, Pred(NumReturn));
for Serie := 1 to Order do
begin
ChartFX.ThisSerie := Pred(Serie);
for Point := 0 to Pred(NumReturn) do
ChartFX.XValue[Point] := mSolutionValues[1, Succ(Point)];
end;
ChartFX.CloseData(Cod_XValues);
}
end;
2 :begin
LoadMatrixSolveFromStrGrd(mSolutionValues, StringGrid_Solve2);
SetAdm;
ChartFX.OpenDataEx(Cod_Values, Order, Pred(NumReturn));
for Serie := 1 to Order do
begin
ChartFX.SerLeg[Pred(Serie)] := 'X ' + IntToStr(Serie);
ChartFX.ThisSerie := Pred(Serie);
for Point := 0 to Pred(NumReturn) do
ChartFX.Value[Point] := mSolutionValues[Serie, Succ(Point)];
end;
ChartFX.CloseData(Cod_Values);
end;
end;
mSolutionValues.Free;
end;
end;
procedure ComputeFromPage2;
begin
ComputeFromPage1;
end;
procedure ComputeFromPage3;
begin
case Form_Main.RadioGroupChart.ItemIndex of
0 :ShowChart(1);
1 :ShowChart(2);
end;
end;
end.
unit Matrix;
interface
uses SysUtils;
type
Float = Extended;
EMatrixOperatingError = class (Exception);
const
NearlyZero = 1E-15;
type
TMatrix = class (TObject)
private
DataPtr: Pointer;
FCols, FRows: Word;
function GetCell (ACol, ARow: Word): Float;
procedure SetCell (ACol, ARow: Word; AValue: Float);
function GetItem (NumItem: LongInt): Float;
procedure SetItem (NumItem: LongInt; AValue: Float);
procedure SwitchRows (FirstRow, SecondRow: Word);
public
constructor Create (NCols, NRows: Word);
destructor Destroy; override;
procedure Assign (AMatrix: TMatrix);
procedure ReSize (NewCols, NewRows: Word);
procedure SetNull;
procedure SetSingle;
procedure SetNegative;
procedure AddConst (AConst: Float);
procedure AddMatrix (AMatrix: TMatrix);
procedure MultConst (MConst: Float);
procedure MultFromRight (MMatrix: TMatrix);
procedure MultFromLeft (MMatrix: TMatrix);
procedure NthPower (Power: Word);
procedure Transpose;
function Inverse: Boolean;
function Determinant: Float;
function Rang: Float;
property ColCount: Word read FCols;
property RowCount: Word read FRows;
property Cells [ACol, ARow: Word]: Float read GetCell write SetCell; default;
property Items [NumItem: LongInt]: Float read GetItem write SetItem;
end;
implementation
uses Windows;
function IncPtr (p: Pointer; i: LongInt): Pointer;
asm
push EBX
mov EBX,EAX
add EBX,EDX
mov EAX,EBX
pop EBX
end;
function TMatrix.GetCell (ACol, ARow: Word): Float;
var
CellPtr: ^Float;
begin
CellPtr := IncPtr(DataPtr, (FRows * Pred(ACol) + Pred(ARow)) * SizeOf(Float));
Result := CellPtr^;
end;
procedure TMatrix.SetCell (ACol, ARow: Word; AValue: Float);
var
CellPtr: ^Float;
begin
CellPtr := IncPtr(DataPtr, (FRows * Pred(ACol) + Pred(ARow)) * SizeOf(Float));
CellPtr^ := AValue;
end;
function TMatrix.GetItem (NumItem: LongInt): Float;
var
CellPtr: ^Float;
begin
CellPtr := IncPtr(DataPtr, Pred(NumItem) * SizeOf(Float));
Result := CellPtr^;
end;
procedure TMatrix.SetItem (NumItem: LongInt; AValue: Float);
var
CellPtr: ^Float;
begin
CellPtr := IncPtr(DataPtr, Pred(NumItem) * SizeOf(Float));
CellPtr^ := AValue;
end;
procedure TMatrix.SwitchRows (FirstRow, SecondRow: Word);
var
i: Word;
Buffer: Float;
begin
for i := 1 to FCols do
begin
Buffer := GetCell(i, FirstRow);
SetCell(i, FirstRow, GetCell(i, SecondRow));
SetCell(i, SecondRow, Buffer);
end;
end;
constructor TMatrix.Create (NCols, NRows: Word);
begin
inherited Create;
FCols := NCols;
FRows := NRows;
DataPtr := AllocMem(FCols * FRows * SizeOf(Float));
end;
destructor TMatrix.Destroy;
begin
FreeMem(DataPtr);
inherited Destroy;
end;
procedure TMatrix.Assign (AMatrix: TMatrix);
var
NewMatrixSize: LongInt;
begin
NewMatrixSize := AMatrix.ColCount * AMatrix.RowCount * SizeOf(Float);
ReAllocMem(DataPtr, NewMatrixSize);
CopyMemory(DataPtr, AMatrix.DataPtr, NewMatrixSize);
FCols := AMatrix.ColCount;
FRows := AMatrix.RowCount
end;
procedure TMatrix.ReSize (NewCols, NewRows: Word);
var
NewMatrixSize: LongInt;
begin
NewMatrixSize := NewCols * NewRows * SizeOf(Float);
ReAllocMem(DataPtr, NewMatrixSize);
FCols := NewCols;
FRows := NewRows;
end;
procedure TMatrix.SetNull;
begin
![](https://s.studizba.com/z.php?f=/templates/si/i/noavatar.png&w=100&h=100&t=1"){kind=avatar}
