Delphi版的线性回归分析

文章《C语言版的线性回归分析函数》发布后，不少朋友留言或给我来信，询问能否提供Delphi版的线性回归分析代码，因C语言版是我以前DOS下的老代码稍作整理后发布的，所以没有现成的Delphi代码，今天比较闲，于是将C代码改写为Delphi代码贴在下面，有关的回归公式说明及例子图示可参见《C语言版的线性回归分析函数》，这里不再累叙，由于改写时间仓促，可能有错误，请不吝指出，亦可来信建议：[e-mail]

线性回归分析代码：

unitRegression;

interface

usesSysUtils;

type
PEquationsData=^TEquationsData;
TEquationsData=array[0..0]ofDouble;
//线性回归
TLinearRegression=class(TObject)
private
FData:PEquationsData;
FAnswer:PEquationsData;
FSquareSum:Double;
FSurplusSum:Double;
FRowCount:Integer;
FColCount:Integer;
FModify:Boolean;
functionGetAnswer(Index:Integer):Double;
functionGetItem(ARow,ACol:Integer):Double;
procedureSetItem(ARow,ACol:Integer;constValue:Double);
procedureSetColCount(constValue:Integer);
procedureSetRowCount(constValue:Integer);
procedureSetSize(constARowCount,AColCount:Integer);
procedureSetModify(constValue:Boolean);
functionGetCorrelation:Double;
functionGetDeviatSum:Double;
functionGetFTest:Double;
functionGetSurplus:Double;
functionGetVariance:Double;
functionGetStandardDiffer:Double;
functionGetEstimate(ARow:Integer):Double;
public
constructorCreate(constAData;constARowCount,AColCount:Integer);overload;
destructorDestroy;override;
//计算回归方程
procedureCalculation;
//设置回归数据
//AData[ARowCount*AColCount]二维数组；X1i,X2i,...Xni,Yi(i=0toARowCount-1)
//ARowCount：数据行数；AColCount数据列数
procedureSetData(constAData;constARowCount,AColCount:Integer);
//数据列数(自变量个数+Y)
propertyColCount:IntegerreadFColCountwriteSetColCount;
//数据行数
propertyRowCount:IntegerreadFRowCountwriteSetRowCount;
//原始数据
propertyData[ARow,ACol:Integer]:DoublereadGetItemwriteSetItem;default;
propertyModify:BooleanreadFModify;
//回归系数数组(B0,B1...Bn)
propertyAnswer[Index:Integer]:DoublereadGetAnswer;
//Y估计值
propertyEstimate[ARow:Integer]:DoublereadGetEstimate;
//回归平方和
propertyRegresSquareSum:DoublereadFSquareSum;
//剩余平方和
propertySurplusSquareSum:DoublereadFSurplusSum;
//离差平方和
propertyDeviatSquareSum:DoublereadGetDeviatSum;
//回归方差
propertyRegresVariance:DoublereadGetVariance;
//剩余方差
propertySurplusVariance:DoublereadGetSurplus;
//标准误差
propertyStandardDiffer:DoublereadGetStandardDiffer;
//相关系数
propertyCorrelation:DoublereadGetCorrelation;
//F检验
propertyF_Test:DoublereadGetFTest;
end;

//解线性方程。AData[count*(count+1)]矩阵数组；count：方程元数；
//Answer[count]：求解数组。返回：True求解成功，否则无解或者无穷解
functionLinearEquations(constAData;Count:Integer;varAnswer:arrayofDouble):Boolean;

implementation

const
SMatrixSizeError='Regressiondatamatrixcannotbelessthan2*2';
SIndexOutOfRange='indexoutofrange';
SEquationNoSolution='EquationnosolutionorInfiniteSolutions';

functionLinearEquations(constAData;Count:Integer;varAnswer:arrayofDouble):Boolean;
var
j,m,n,ColCount:Integer;
tmp:Double;
Data,d:PEquationsData;
begin
Result:=False;
ifCount<2thenExit;

ColCount:=Count+1;
GetMem(Data,Count*ColCount*Sizeof(Double));
GetMem(d,ColCount*Sizeof(Double));
try
Move(AData,Data^,Count*ColCount*Sizeof(Double));
form:=0toCount-2do
begin
n:=m+1;
//如果主对角线元素为0，行交换
while(n<Count)and(Data^[m*ColCount+m]=0.0)do
begin
ifData^[n*ColCount+m]<>0.0then
begin
Move(Data^[m*ColCount+m],d^,ColCount*Sizeof(Double));
Move(Data^[n*ColCount+m],Data^[m*ColCount+m],ColCount*Sizeof(Double));
Move(d^,Data^[n*ColCount+m],ColCount*Sizeof(Double));
end;
Inc(n);
end;
//行交换后，主对角线元素仍然为0，无解
ifData^[m*ColCount+m]=0.0thenExit;
//消元
forn:=m+1toCount-1do
begin
tmp:=Data^[n*ColCount+m]/Data^[m*ColCount+m];
forj:=mtoCountdo
Data^[n*ColCount+j]:=Data^[n*ColCount+j]-tmp*Data^[m*ColCount+j];
end;
end;
FillChar(d^,Count*Sizeof(Double),0);
//求得count-1的元
Answer[Count-1]:=Data^[(Count-1)*ColCount+Count]/
Data^[(Count-1)*ColCount+Count-1];
//逐行代入求各元
form:=Count-2downto0do
begin
forj:=Count-1downtom+1do
d^[m]:=d^[m]+Answer[j]*Data^[m*ColCount+j];
Answer[m]:=(Data^[m*ColCount+Count]-d^[m])/Data^[m*ColCount+m];
end;
Result:=True;
finally
FreeMem(d);
FreeMem(Data);
end;
end;

{TLinearRegression}

procedureTLinearRegression.Calculation;
var
m,n,i,count:Integer;
dat:PEquationsData;
a,b,d:Double;
begin
if(FRowCount<2)or(FColCount<2)then
raiseException.Create(SMatrixSizeError);
ifnotFModifythenExit;
GetMem(dat,FColCount*(FColCount+1)*Sizeof(Double));
try
count:=FColCount-1;
dat^[0]:=FRowCount;
forn:=0tocount-1do
begin
a:=0.0;
b:=0.0;
form:=0toFRowCount-1do
begin
d:=FData^[m*FColCount+n];
a:=a+d;
b:=b+d*d;
end;
dat^[n+1]:=a;
dat^[(n+1)*(FColCount+1)]:=a;
dat^[(n+1)*(FColCount+1)+n+1]:=b;
fori:=n+1tocount-1do
begin
a:=0.0;
form:=0toFRowCount-1do
a:=a+FData^[m*FColCount+n]*FData^[m*FColCount+i];
dat^[(n+1)*(FColCount+1)+i+1]:=a;
dat^[(i+1)*(FColCount+1)+n+1]:=a;
end;
end;
b:=0.0;
form:=0toFRowCount-1do
b:=b+FData^[m*FColCount+count];
dat^[FColCount]:=b;
forn:=0tocount-1do
begin
a:=0.0;
form:=0toFRowCount-1do
a:=a+FData^[m*FColCount+n]*FData^[m*FColCount+count];
dat^[(n+1)*(FColCount+1)+FColCount]:=a;
end;
ifnotLinearEquations(dat^,FColCount,FAnswer^)then
raiseException.Create(SEquationNoSolution);
FSquareSum:=0.0;
FSurplusSum:=0.0;
b:=b/FRowCount;
form:=0toFRowCount-1do
begin
a:=FAnswer^[0];
fori:=1tocountdo
a:=a+FData^[m*FColCount+i-1]*FAnswer[i];
FSquareSum:=FSquareSum+(a-b)*(a-b);
d:=FData^[m*FColCount+count];
FSurplusSum:=FSurplusSum+(d-a)*(d-a);
end;
SetModify(False);
finally
FreeMem(dat);
end;
end;

constructorTLinearRegression.Create(constAData;constARowCount,
AColCount:Integer);
begin
SetData(AData,ARowCount,AColCount);
end;

destructorTLinearRegression.Destroy;
begin
SetSize(0,0);
end;

functionTLinearRegression.GetAnswer(Index:Integer):Double;
begin
if(Index<0)or(Index>=FColCount)then
raiseException.Create(SIndexOutOfRange);
ifnotAssigned(FAnswer)then
Result:=0.0
else
Result:=FAnswer^[Index];
end;

functionTLinearRegression.GetCorrelation:Double;
begin
Result:=DeviatSquareSum;
ifResult<>0.0then
Result:=Sqrt(FSquareSum/Result);
end;

functionTLinearRegression.GetDeviatSum:Double;
begin
Result:=FSquareSum+FSurplusSum;
end;

functionTLinearRegression.GetEstimate(ARow:Integer):Double;
var
I:Integer;
begin
if(ARow<0)or(ARow>=FRowCount)then
raiseException.Create(SIndexOutOfRange);
Result:=Answer[0];
forI:=1toColCount-1do
Result:=Result+FData^[ARow*FColCount+I-1]*Answer[I];
end;

functionTLinearRegression.GetFTest:Double;
begin
Result:=SurplusVariance;
ifResult<>0.0then
Result:=RegresVariance/Result;
end;

functionTLinearRegression.GetItem(ARow,ACol:Integer):Double;
begin
if(ARow<0)or(ARow>=FRowCount)or(ACol<0)or(ACol>=FColCount)then
raiseException.Create(SIndexOutOfRange);
Result:=FData^[ARow*FColCount+ACol];
end;

functionTLinearRegression.GetStandardDiffer:Double;
begin
Result:=Sqrt(SurplusVariance);
end;

functionTLinearRegression.GetSurplus:Double;
begin
ifFRowCount-FColCount<1then
Result:=0.0
else
Result:=FSurplusSum/(FRowCount-FColCount);
end;

functionTLinearRegression.GetVariance:Double;
begin
ifFColCount<2then
Result:=0.0
else
Result:=FSquareSum/(FColCount-1);
end;

procedureTLinearRegression.SetColCount(constValue:Integer);
begin
ifValue<2then
raiseException.Create(SMatrixSizeError);
SetSize(FRowCount,Value);
end;

procedureTLinearRegression.SetData(constAData;constARowCount,AColCount:Integer);
begin
if(ARowCount<2)or(AColCount<2)then
raiseException.Create(SMatrixSizeError);
SetSize(ARowCount,AColCount);
Move(AData,FData^,FRowCount*FColCount*Sizeof(Double));
end;

procedureTLinearRegression.SetItem(ARow,ACol:Integer;constValue:Double);
begin
if(ARow<0)or(ARow>=FRowCount)or(ACol<0)or(ACol>=FColCount)then
raiseException.Create(SIndexOutOfRange);
ifFData^[ARow*(FColCount)+ACol]<>Valuethen
begin
FData^[ARow*(FColCount)+ACol]:=Value;
SetModify(True);
end;
end;

procedureTLinearRegression.SetModify(constValue:Boolean);
begin
ifFModify<>Valuethen
begin
FModify:=Value;
ifFModifythen
begin
FillChar(FAnswer^,FColCount*Sizeof(Double),0);
FSquareSum:=0.0;
FSurplusSum:=0.0;
end;
end;
end;

procedureTLinearRegression.SetRowCount(constValue:Integer);
begin
ifValue<2then
raiseException.Create(SMatrixSizeError);
SetSize(Value,FColCount);
end;

procedureTLinearRegression.SetSize(constARowCount,AColCount:Integer);
begin
if(FRowCount=ARowCount)and(FColCount=AColCount)then
Exit;
ifAssigned(FData)then
begin
FreeMem(FData);
FData:=nil;
FreeMem(FAnswer);
FAnswer:=nil;
FModify:=False;
end;

FRowCount:=ARowCount;
FColCount:=AColCount;

if(FRowCount=0)or(FColCount=0)thenExit;

GetMem(FData,FRowCount*FColCount*Sizeof(Double));
FillChar(FData^,FRowCount*FColCount*Sizeof(Double),0);
GetMem(FAnswer,FColCount*Sizeof(Double));
SetModify(True);
end;

end.

因为一元线性回归分析本是多元线性回归分析的一个特例，因此原C代码中的一元线性回归函数取消，一元线性回归和多元线性回归都使用TLinearRegression类。下面是Pascal控制台应用程序例子：

programLinearRegression;

{$APPTYPECONSOLE}

uses
SysUtils,
Regressionin'....pasRegression.pas';

const
data1:array[1..12,1..2]ofDouble=(
//XY
(187.1,25.4),
(179.5,22.8),
(157.0,20.6),
(197.0,21.8),
(239.4,32.4),
(217.8,24.4),
(227.1,29.3),
(233.4,27.9),
(242.0,27.8),
(251.9,34.2),
(230.0,29.2),
(271.8,30.0)
);

data:array[1..15,1..5]ofDouble=(
//X1X2X3X4Y
(316,1536,874,981,3894),
(385,1771,777,1386,4628),
(299,1565,678,1672,4569),
(326,1970,785,1864,5340),
(441,1890,785,2143,5449),
(460,2050,709,2176,5599),
(470,1873,673,1769,5010),
(504,1955,793,2207,5694),
(348,2016,968,2251,5792),
(400,2199,944,2390,6126),
(496,1328,749,2287,5025),
(497,1920,952,2388,5924),
(533,1400,1452,2093,5657),
(506,1612,1587,2083,6019),
(458,1613,1485,2390,6141)
);

procedureDisplay(s:string;R:TLinearRegression);
var
i:Integer;
v,o:Double;
begin
Writeln(s);
Writeln('回归方程式:');
Write('Y=',R.Answer[0]:1:5);
fori:=1toR.ColCount-1do
Write('+',R.Answer[i]:1:5,'*X',i);
Writeln;
Writeln('回归显著性检验:');
Writeln('回归平方和：',R.RegresSquareSum:12:4,'回归方差：',R.RegresVariance:12:4);
Writeln('剩余平方和：'<span

分享到：

Delphi图像处理 -- 图像的灰度化、二值化及 ... | 谈谈RJ45线序的打法及口诀

• 2007-11-26 19:02
• 浏览 740
• 评论(0)
• 查看更多

相关推荐

线性回归分析Delphi源码

在本案例中，"线性回归分析Delphi源码"指的是使用Delphi编程语言实现的线性回归算法的源代码。Delphi是一款强大的Object Pascal集成开发环境，常用于创建桌面应用程序。 线性回归的基本思想是找到一条直线（在多...

线性非线性回归

在描述中提到的"多元非线性回归分析"是指包含多个自变量的非线性模型。在这种情况下，模型会尝试找出因变量与多个自变量之间非线性的复合关系。例如，一个非线性模型可能包含自变量的指数、对数或其他非线性变换，以...

多元非线性回归分析源代码

在这个特定的压缩包中，我们有“多元非线性回归分析”的源代码，这表明我们可以深入学习如何在Delphi环境中实现非线性模型的计算和拟合。 在非线性回归中，我们通常假设因变量Y依赖于一个或多个自变量X通过一个非...

简单线性回归：简单线性回归

在进行回归分析之前，我们通常需要将数据分为训练集和测试集，以便评估模型的泛化能力： ```python X_train, X_test, y_train, y_test = train_test_split(X, y, test_size=0.2, random_state=42) ``` 然后，创建...

Delphi常用算法

此外，还可以构建统计模型，如线性回归、逻辑回归和时间序列分析。比如，你可以使用Rtti（运行时类型信息）来动态处理不同数据集，并使用图形库如VCL Charts或TeeChart绘制统计图表，直观地展示数据分布和趋势。 四...

delphi决策支持代码

在这个场景下，我们关注的是如何利用Delphi编程语言构建一个决策支持代码，特别是涉及到一元线性回归分析。一元线性回归是一种统计方法，用于研究两个变量之间的关系，其中一个变量是独立的（自变量），另一个是依赖...

时间序列模型的Delphi程序实现

3. **预测模型计算**：通过线性回归公式计算了预测值`v`，该值基于时间序列的历史数据及其统计特性。这里使用了简单的线性回归方法，其中包含了参数估计和误差项的调整。 4. **残差计算与均值调整**：通过再次循环...

zuixiaoerchengfa.rar_Delphi regression_K._delphi 最小二乘法_最小二乘法_误差修

在实际应用中，最小二乘法不仅可以用于线性回归，还可以扩展到多项式回归、非线性回归等多种情况。对于非线性问题，可以通过将非线性模型转化为线性模型（例如，通过泰勒展开或对数变换），然后应用最小二乘法求解。...

Delphi常用数值算法集

在概率统计中，算法集可能包含抽样分布、假设检验、回归分析等内容。比如，快速傅里叶变换（FFT）在信号处理中广泛应用，而马尔可夫链蒙特卡洛（MCMC）方法则用于处理复杂的概率模型。 此外，数值积分是解决物理、...

《Delphi 常用数值算法集》全书的源代码

6. **统计分析**：包括均值、中位数、标准差、方差计算，以及假设检验、回归分析等，对于数据分析和决策支持至关重要。 7. **随机数生成**：提供了各种分布的随机数生成器，如均匀分布、正态分布、泊松分布等，用于...

Delphi数字矩阵演示程序.rar

3. 数据分析：在统计和数据分析中，矩阵可以用于处理大量数据，进行线性回归、主成分分析等。 总的来说，"Delphi数字矩阵演示程序"为初学者提供了一个了解和实践矩阵编程的好机会。通过学习和理解这段源代码，...

Delphi RBF 神经网络源码

Delphi RBF（Radial Basis Function，径向基函数）神经网络源码是一个用于实现RBF网络的编程代码，主要用于解决非线性回归和分类问题。RBF网络因其特殊的结构和快速的学习能力，在数据拟合、模式识别等领域有着广泛...

linear-regression2.zip_Delphi控件源码_Delphi_

在Delphi编程环境中，实现线性回归分析可以帮助开发者在软件中集成预测和数据分析功能。本压缩包"linear-regression2.zip"包含了一份用Delphi语言编写的线性回归控件源码，对于Delphi程序员来说，这是一个宝贵的资源...

常用数值算法丛书 Delphi常用数值算法集源代码

4. **统计与概率**：如随机数生成、概率分布函数、假设检验、回归分析等，这些在统计学和数据分析中不可或缺。 5. **数值解方程**：根查找算法，如二分法、牛顿法及其变种，用于求解非线性方程。 6. **特殊函数**...

ESBMaths 一些有用的Delphi 数学公式包..rar

5. **统计分析**：ESBMaths可能还包含了基本的统计分析功能，如均值、中位数、方差、标准差的计算，以及相关系数、回归分析等统计方法，便于开发者在Delphi程序中进行数据分析。 6. **图形绘制**：为了可视化数据和...

Delphi常用数值算法源代码.rar

4. **数值概率与统计**：这可能包括随机数生成、统计测试（如t检验、卡方检验）、回归分析、蒙特卡洛模拟等。在金融工程、风险评估、社会科学实验等领域，这些算法有广泛应用。 5. **数值解方程**：比如牛顿迭代法...

TregComp

"TregComp"是一个专注于统计学中的多元线性回归分析及与其相关的诊断程序的源代码库。它为研究者和开发者提供了一套全面的工具，用于处理和分析复杂的多变量数据集。下面，我们将深入探讨这个项目中的关键组成部分和...

Delphi在电力系统中的应用

2. 负荷预测模块：这一模块是系统的核心部分，负责执行各种预测方法，如线性外推法、回归分析法、时间序列法和节假日负荷预测法等。该模块通过处理历史数据，预测未来的电力负荷，并提供预测结果。 3. 预测结果查询...

y=aX+b中求AB值采用最小二乘拟合ab

这些文件与最小二乘法本身不直接相关，但它们可能包含了一个程序或应用程序，该程序用于处理数据，包括应用最小二乘法进行线性回归分析。在Delphi这样的环境中，用户可以编写代码来实现最小二乘拟合，并可视化结果。...