unit
TestMNKFunc;
interface
uses
type
TForm1 =
class
(TForm)
private
Sr2:TLineSeries;
Sr1:TPointSeries;
Xmax, Xmin:
Extended
;
NumX:
Integer
;
procedure
StrGr1Chart1Data;
Public
end
;
var
Form1: TForm1;
implementation
Uses
UnitData,UnitMNK;
{$R *.dfm}
procedure
TForm1
.
FormCreate(Sender: TObject);
begin
Randomize;
with
StringGrid1
do
begin
if
not
(goColSizing
in
Options)
then
Options:=Options+[goColSizing];
FixedCols:=
0
;
Constraints
.
MinWidth:=
50
;
DefaultRowHeight:=
18
;
ColCount:=
3
;
RowCount:=
2
;
cells[
0
,
0
]:=
'X'
;
cells[
1
,
0
]:=
'y(x)'
;
cells[
2
,
0
]:=
'yApr(x)'
;
ColWidths[
0
]:=
120
;
ColWidths[
1
]:=
120
;
ColWidths[
2
]:=
120
;
end
;
Sr1:=TPointSeries
.
Create(Chart1);
Sr2:=TLineSeries
.
Create(Chart1);
Sr1
.
Title:=ys;
Sr2
.
Title:=yAprs;
with
Chart1
do
begin
AddSeries(Sr1);
AddSeries(Sr2);
Constraints
.
MinWidth:=
100
;
Cursor := crCross;
AllowPanning := pmBoth;
AllowZoom :=
True
;
View3D :=
False
;
Color := clWhite;
Legend
.
Visible :=
True
;
Legend
.
LegendStyle :=lsSeries;
Title
.
Visible :=
True
;
Title
.
Alignment:=taCenter;
Title
.
Text
.
Clear;
LeftAxis
.
AxisValuesFormat :=
'0.00'
;
BottomAxis
.
AxisValuesFormat :=
'0.00'
;
BottomAxis
.
Title
.
Caption:=
'x'
;
LeftAxis
.
Title
.
Caption:=
'y(x)'
;
TopAxis
.
Automatic:=
True
;
LeftAxis
.
Automatic:=
True
;
end
;
end
;
procedure
TForm1
.
FormClose(Sender: TObject;
var
Action: TCloseAction);
begin
FreeAndNil(Sr1);
FreeAndNil(Sr2);
end
;
procedure
TForm1
.
ToolButton1Click(Sender: TObject);
begin
if
FrmData
.
ShowModal = mrOK
then
Try
Xmax:= StrTofloat(FrmData
.
LbEdXmax
.
text);
Xmin:= StrTofloat(FrmData
.
LbEdXmin
.
Text);
NumX:= StrToInt(FrmData
.
LbEdNumX
.
text);
except
ShowMessage(
'Неверные данные'
);
ToolButton1Click(Sender)
end
;
StrGr1Chart1Data;
end
;
procedure
TForm1
.
StrGr1Chart1Data;
var
i, j:
Integer
;
x, xi, yi, ay, a, b, c, DltX, r_2:
Extended
;
begin
x:=Xmin;
DltX:=(Xmax-Xmin)/(NumX-
1
);
mnk(Xmin,Xmax, NumX, a,b,c);
r_2:=R2(Xmin,Xmax, a,b,c, NumX);
Sr1
.
Clear;
Sr2
.
Clear;
with
StringGrid1
do
begin
RowCount:=NumX+
1
;
for
i:=
1
to
RowCount-
1
do
begin
x:=Xmin+DltX*(i-
1
);
yi:=y(x);
ay:=yApr(x,a,b,c);
cells[
0
,i]:= FloatToStr(x);
cells[
1
,i]:= FloatToStr(yi);
cells[
2
,i]:= FloatToStr(ay);
Sr1
.
AddXY(x,yi);
Sr2
.
AddXY(x,ay);
if
i= NumX
then
break;
xi:=x;
for
j:=
1
to
9
do
begin
x:=xi+DltX*j/
10.0
;
ay:=yApr(x,a,b,c);
Sr2
.
AddXY(x,ay);
end
;
end
;
end
;
Chart1
.
Foot
.
Caption:=
'Аппроксимация данных квадратичной функцией'
;
Chart1
.
Title
.
Text
.
Clear;
Chart1
.
Title
.
Text
.
Add(format(
' a=%4.3f; b=%4.3f; c=%4.3f; R2=%4.3f '
, [a, b, c, r_2] ));
end
;
end
.
-------------------------------------------------------------------------------
yPress(Sender: TObject;
var
Key:
Char
);
begin
with
sender
as
TLabeledEdit
do
begin
if
key=chr(vk_back)
then
exit;
if
(key=
','
)
or
(key=
'-'
)
then
exit;
if
not
(key
in
KeyDig)
then
key:=#
0
;
end
;
end
;
procedure
TFrmData
.
LbEdNumXKeyPress(Sender: TObject;
var
Key:
Char
);
begin
if
key=chr(vk_back)
then
exit;
if
not
(key
in
KeyDig)
then
key:=#
0
;
end
;
procedure
TFrmData
.
BitBtn1Click(Sender: TObject);
begin
ModalResult:=mrOk;
if
Trim(LbEdXmax
.
text+LbEdXmin
.
text+LbEdNumX
.
text)=
''
then
begin
ShowMessage(
'введите данные'
);
ModalResult:=mrNone;
end
;
if
Trim(LbEdXmax
.
text)=Trim(LbEdXmin
.
text)
then
begin
ShowMessage(
'Xmax=Xmin ???'
);
ModalResult:=mrNone;
end
;
end
;
procedure
TFrmData
.
BitBtn2Click(Sender: TObject);
begin
ModalResult:=mrCancel;
end
;
procedure
TFrmData
.
LbEdXminKeyDown(Sender: TObject;
var
Key:
Word
; Shift: TShiftState);
begin
if
key=vk_Return
then
LbEdXmax
.
SetFocus;
end
;
procedure
TFrmData
.
LbEdXmaxKeyDown(Sender: TObject;
var
Key:
Word
; Shift: TShiftState);
begin
if
key=vk_Return
then
LbEdNumX
.
SetFocus;
end
;
procedure
TFrmData
.
LbEdNumXKeyDown(Sender: TObject;
var
Key:
Word
; Shift: TShiftState);
begin
if
key=vk_Return
then
BitBtn1
.
SetFocus;
end
;
end
.
--------------------------------------------------------------
unit
UnitMNK;
interface
uses
SysUtils, Vcl
.
Dialogs;
const
ys=
'random'
;
yAprs=
'ax^2+bx+c'
;
function
y(x:
Extended
):
Extended
;
function
yApr(x, a,b,c:
Extended
):
Extended
;
procedure
mnk( Xmin,Xmax:
Extended
; n:
Integer
;
var
a,b,c:
Extended
);
function
R2( Xmin,Xmax, a,b,c:
Extended
; n:
Integer
):
Extended
;
implementation
function
y(x:
Extended
):
Extended
;
var
a,b,c,r:
Extended
;
begin
a:=
2.2
;
b:=
8.3
;
c:=
3.4
;
try
result:=a*x*x+b*x+c;
r:= random*
0.5
*
abs
(result);
result:=result+r;
except
raise
Exception
.
Create(
'Ошибка при расчете функции y='
+ys);
end
;
end
;
function
yApr(x, a,b,c:
Extended
):
Extended
;
begin
try
result:=a*x*x+b*x+c;
except
raise
Exception
.
Create(
'Ошибка при расчете функции y='
+yAprs);
end
;
end
;
procedure
mnk( Xmin,Xmax:
Extended
; n:
Integer
;
var
a,b,c:
Extended
);
var
S1,S2,S3,S4,S5,S6,S7,S12,S13,S24,S15,S25,x,yi,DltX,ycr :
Extended
;
i:
Integer
;
begin
S1:=
0.0
; S2:=
0.0
; S3:=
0.0
;
S4:=
0.0
; S5:=
0.0
; S6:=
0.0
; S7:=
0.0
;
x:=Xmin;
DltX:=(Xmax-Xmin)/(n-
1
);
for
i:=
1
to
n
do
begin
x:=Xmin+DltX*(i-
1
);
yi:=y(x);
S1:= S1+x;
S2:= S2+x*x;
S3:= S3+x*x*x;
S4:= S4+x*x*x*x;
S5:= S5+yi;
S6:= S6+x*yi;
S7:= S7+x*x*yi;
end
;
S12:=(S2*n - S1*S1);
S13:=(S3*n - S1*S2);
S24:=(S4*n - S2*S2);
S15:=(-S5*S1 + S6*n);
S25:=(-S5*S2 + S7*n);
try
b:=(S25*S13 - S15*S24)/(S13*S13 - S12*S24);
a:=(S15*S13 - S25*S12)/(S13*S13 - S24*S12);
c:= (S5 - b*S1 - a*S2)/n;
except
raise
Exception
.
Create(
'Ошибка при расчете функции y='
+yAprs);
end
;
end
;
function
R2( Xmin,Xmax, a,b,c:
Extended
; n:
Integer
):
Extended
;
var
x,yi,ycr,ya,SSr,SSt,DltX :
Extended
;
i:
Integer
;
begin
x:=Xmin;
DltX:=(Xmax-Xmin)/(n-
1
);
ycr:=
0.0
;
for
i:=
1
to
n
do
begin
ycr:=ycr+y(x);
end
;
ycr:=ycr/n;
x:=Xmin;
SSr:=
0.0
;
SSt:=
0.0
;
for
i:=
1
to
n
do
begin
x:=Xmin+DltX*(i-
1
);
yi:=y(x);
ya:=yApr(x, a,b,c);
SSr:=SSr+(yi-ya)*(yi-ya);
SSt:=SSt+(yi-ycr)*(yi-ycr);
end
;
try
R2:=
1
-SSr/SSt;
except
R2:=
1
-SSr;
end
;
end
;
end
.