文章《C语言版的线性回归分析函数》发布后，不少朋友留言或给我来信，询问能否提供Delphi版的线性回归分析代码，因C语言版是我以前DOS下的老代码稍作整理后发布的，所以没有现成的Delphi代码，今天比较闲，于是将C代码改写为Delphi代码贴在下面，有关的回归公式说明及例子图示可参见《C语言版的线性回归分析函数》，这里不再累叙，由于改写时间仓促，可能有错误，请不吝指出，亦可来信建议：maozefa@hotmail.com
线性回归分析代码：
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源码线性回归分析Delphi源码
线性回归分析线性回归分析线性回归分析线性回归分析线性回归分析线性回归分析线性回归分析
Delphi写的线性回归Unit，支持一元线性回归与多元线性回归，添加到工程里可以直接使用。Delphi写的线性回归Unit，支持一元线性回归与多元线性回归，添加到工程里可以直接使用。Delphi写的线性回归Unit，支持一元线性...
线性回归是利用数理统计中回归分析，来确定两种或两种以上变量间相互依赖的定量关系的一种统计分析方法，运用十分广泛。其表达形式为y = w'x+e，e为误差服从均值为0的正态分布。回归分析中，只包括一个自变量和一个...
介绍了线性回归分析的基础，如一元线性回归和多元线性回归
基于MATLAB的多元回归分析及应用案例
一元线性回归线性...分析偏最小二乘回归参数估计方法改进岭回归主成分回归一元非线性回归非线性回归分段回归多元非线性回归自变量含有含有定性变量的回归...
一元线性回归模型，方差分析，非线性回归模型
代码 多元线性回归代码代码 多元线性回归代码代码 多元线性回归代码代码 多元线性回归代码代码 多元线性回归代码代码 多元线性回归代码代码 多元线性回归代码代码 多元线性回归代码代码 多元线性回归代码代码 多元...
非线性回归是回归函数关于未知回归系数具有非线性结构的回归。常用的处理方法有回归函数的线性迭代法、分段回归法、迭代最小二乘法等。非线性回归分析的主要内容与线性回归分析相似。
多元非线性回归分析
基于spss的一元线性回归与多元线性回归案例，个人整理出的，包含了部分案例、实验报告、题目，及部分题目答案，适合作为spss、MATLAB等软件数据分析题目联系
我国国内生产总值地多元线性回归分析报告.doc
基于多元线性回归分析影响人均GDP的因素
线性回归问题与非线性回归分析PPT学习教案.pptx
代码 一元线性回归代码代码 一元线性回归代码代码 一元线性回归代码代码 一元线性回归代码代码 一元线性回归代码代码 一元线性回归代码代码 一元线性回归代码代码 一元线性回归代码代码 一元线性回归代码代码 一元...
使用SPSS软件进行线性回归分析，包括回归分析概述 线性回归分析 回归方程的统计检验 多元回归分析中的其他问题 线性回归分析的基本操作 线性回归分析的应用举例 曲线估计
提出了一种基于遗传算法模糊多元线性回归分析的瓦斯涌出量预测模型 。 采用灰关联分析法和 ＳＰＳＳ 软件线性回归分析法确定影响瓦斯涌出量的主要因素 ； 把历史数据样本分为建模数据样本和检测数据 样本 ， 采用...
数学工具，用于多元非线性回归分析，包含源代码，适用于源代码的学习和数学工具的使用
紧接着，我们介绍多项式回归分析（polynomial regression问题），一种具有非线性关系的多元线性回归问题。最后，我们介绍如果训练模型获取目标函数最小化的参数值。在研究一个大数据集问题之前，我们先从一个小问题...