Mega Code Archive
Component to calculate a Regression Multiple of a set data
<![CDATA[
Title: Component to calculate a Regression Multiple of a set data
Question: This code was used in a mathematical model to calculate a Regression Multiple in many points of a computational mesh.
Answer:
This code is useful if you want to calculate a lot of times a Regression Multiple procedure.
Y=aX1+bX2+cX3+..+zXn
The following is an example about how to introduce data:
Var
i: Byte;
DatosReg: TStrings;
begin
Try
DatosReg:=TStringList.Create;
with DatosReg do
begin
Add('VarY');
Objects[0]:=TStringList.Create;
Add('VarX1');
Objects[1]:=TStringList.Create;
Add('VarX2');
Objects[2]:=TStringList.Create;
Add('VarX3');
Objects[3]:=TStringList.Create;
...
...
Add('Varn');
Objects[n]:=TStringList.Create;
end;
end;
for i:0 to # do
begin
TStrings(DatosReg.Objects[0]).Add('data');
...
...
end;
Calc Regression:
RegMult.Datos(DatosReg);
Get Coefficients:
for i:=0 to Col-1 do
RegMult.Resultados.Coeficientes[i]);
where Col is the number of x's Cols
end;
The code od the component is the following:
unit RegMult;
interface
uses Classes, SysUtils;
type
TRegMult = class(TComponent)
public
{ Public declarations }
Coeficientes: array of string;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Datos(Const S: TStrings);
protected
{ Protected declarations }
FRow,FCol: longword;
FCoeficienteD: extended;
private
{ Private declarations }
RSuma: array of string;
Sum,MatrixDatos,MatrixA,MatrixB,MatrixC: TStrings;
function Calcular(Const S: TStrings): string;
procedure Suma(Const S: TStrings; Const Colm: longword);
procedure Resolver(Const M1,M2: TStrings);
published
property Row: longword read FRow write FRow;
property Col: longword read FCol write FCol;
property CoeficienteD: extended read FCoeficienteD write FCoeficienteD;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('RegMult', [TRegMult]);
end;
//TRegMult
constructor TRegMult.Create(AOwner: TComponent);
begin
Col:=0;
Row:=0;
CoeficienteD:=0;
inherited Create(AOwner);
end;
destructor TRegMult.Destroy;
begin
Sum:=nil;
MatrixDatos:=nil;
MatrixA:=nil;
MatrixB:=nil;
MatrixC:=nil;
inherited Destroy;
end;
procedure TRegMult.Datos(Const S: TStrings);
var
i,j,k: longword;
begin
with S do
begin
for i:=1 to Count-1 do
begin
Row:=TStrings(Objects[i-1]).Count;
Col:=TStrings(Objects[i]).Count;
if (Col Row) then
raise Exception.Create('Reg Mult: El nmero de filas debe ser el mismo.');
if (Col-1 = Row) then
raise Exception.Create('Reg Mult: El nmero de filas y columnas para el rango X no puede ser el mismo.');
end;
Col:=Count;
end;
if (MatrixDatos = nil) then
begin
SetLength(Coeficientes,Col);
Sum:= TStringList.Create;
MatrixDatos:= TStringList.Create;
MatrixA:= TStringList.Create;
MatrixB:= TStringList.Create;
MatrixC:= TStringList.Create;
for i:=0 to 3 do
case i of
0: with Sum do
for k:=0 to Row-1 do
Add('0');
1: with MatrixDatos do
for j:=0 to Col-1 do
begin
Add(IntToStr(j));
Objects[j]:= TStringList.Create;
for k:=0 to Row-1 do
TStrings(Objects[j]).Add('0');
end;
2: with MatrixA do
for j:=0 to Col-1 do
begin
Add(IntToStr(j));
Objects[j]:= TStringList.Create;
for k:=0 to Col-1 do
TStrings(Objects[j]).Add('0');
end;
3: with MatrixB do
for k:=0 to Col-1 do
Add('0');
end;
end;
Calcular(S);
end;
function TRegMult.Calcular(Const S: TStrings): string;
var
i,j,k: longword;
begin
RSuma:=nil;
SetLength(RSuma,Col);
for i:=0 to Col-1 do
begin
for j:=0 to Col-1 do
for k:=0 to Row-1 do
with MatrixDatos do
if (i = 0) then
TStrings(Objects[j])[k]:=TStrings(S.Objects[j])[k]
else
TStrings(Objects[j])[k]:=FloatToStr(StrToFloat(TStrings(S.Objects[i-1])[k])*StrToFloat(TStrings(S.Objects[j])[k]));
Suma(MatrixDatos,Col);
with MatrixA do
for j:=0 to Col-1 do
begin
if (j = Col-1) then
if (i = 0) then
TStrings(Objects[i])[j]:=IntToStr(TStrings(S.Objects[0]).Count)
else
TStrings(Objects[i])[j]:=TStrings(Objects[0])[i-1]
else
TStrings(Objects[i])[j]:=Rsuma[j];
end;
MatrixB[i]:=RSuma[Col-1];
end;
MatrixC.Clear;
MatrixC.AddStrings(MatrixB);
Resolver(MatrixA,MatrixB);
with MatrixDatos do
for k:=0 to Row-1 do
TStrings(Objects[0])[k]:=FloatToStr(Sqr(StrToFloat(TStrings(S.Objects[Col-1])[k])));
Suma(MatrixDatos,1);
CoeficienteD:=0;
for i:=0 to Col-1 do
if (i = Col-1) then
CoeficienteD:=CoeficienteD+StrToFloat(MatrixC[0])*StrToFloat(Coeficientes[i])
else
CoeficienteD:=CoeficienteD+StrToFloat(MatrixC[i+1])*StrToFloat(Coeficientes[i]);
CoeficienteD:=(CoeficienteD-Row*Sqr(StrToFloat(MatrixC[0])/Row))/(StrToFloat(RSuma[0])-Row*Sqr(StrToFloat(MatrixC[0])/Row));
end;
procedure TRegMult.Suma(Const S: TStrings; Const Colm: longword);
var
i,j: longword;
begin
with S do
for i:=0 to Colm-1 do
begin
Sum[0]:=TStrings(Objects[i])[0];
for j:=1 to Row-1 do
Sum[j]:=FloatToStr(StrToFloat(Sum[j-1])+StrToFloat(TStrings(Objects[i])[j]));
RSuma[i]:=Sum[Row-1];
end;
end;
procedure TRegMult.Resolver(Const M1,M2: TStrings);
var
Susum,Piv,Pibig,Pidum,Pitem,Am: string;
i,i1,i2,j,Elx,Elj,Pij: longword;
begin
for i1:=1 to Col-1 do
begin
Elx:=i1;
Elj:=i1-1;
Pij:=i1-1;
Pibig:=FloatToStr(Abs(StrToFloat(TStrings(M1.Objects[i1-1])[i1-1])));
for i:=Elx to Col do
begin
Am:=FloatToStr(Abs(StrToFloat(TStrings(M1.Objects[i-1])[i1-1])));
if (StrToFloat(Am)StrToFloat(Pibig)) then
begin
Pibig:=Am;
Pij:=i-1;
end;
end;
for j:=Elj to Col-1 do
begin
Pidum:=TStrings(M1.Objects[Pij])[j];
TStrings(M1.Objects[Pij])[j]:=TStrings(M1.Objects[i1-1])[j];
TStrings(M1.Objects[i1-1])[j]:=Pidum;
end;
Pitem:=M2[Pij];
M2[Pij]:=M2[i1-1];
M2[i1-1]:=Pitem;
for i2:=Elx to Col-1 do
if (StrToFloat(TStrings(M1.Objects[i2])[Elj])0) then
begin
Piv:=FloatToStr(StrToFloat(TStrings(M1.Objects[i2])[i1-1])/StrToFloat(TStrings(M1.Objects[i1-1])[i1-1]));
for j:=Elj to Col-1 do
TStrings(M1.Objects[i2])[j]:=FloatToStr(StrToFloat(TStrings(M1.Objects[i2])[j])-StrToFloat(Piv)*StrToFloat(TStrings(M1.Objects[i1-1])[j]));
M2[i2]:=FloatToStr(StrToFloat(M2[i2])-StrToFloat(Piv)*StrToFloat(M2[i1-1]));
end;
end;
Coeficientes[Col-1]:=FloatToStr(StrToFloat(M2[Col-1])/StrToFloat(TStrings(M1.Objects[Col-1])[Col-1]));
for i:=1 to Col-1 do
begin
Susum:='0';
i1:=Col-i-1;
i2:=i1+1;
for j:=i2 to Col-1 do
Susum:=FloatToStr(StrToFloat(Susum)+StrToFloat(TStrings(M1.Objects[i1])[j])*StrToFloat(Coeficientes[j]));
Coeficientes[i1]:=FloatToStr((StrToFloat(M2[i1])-StrToFloat(Susum))/StrToFloat(TStrings(M1.Objects[i1])[i1]));
end;
end;
end.
]]>