Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 12.12.2020, 19:30
Remax_06 Remax_06 вне форума
Прохожий
 
Регистрация: 12.12.2020
Сообщения: 1
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Можете пожалуйста объяснить, какая функция и процедура что делает?

буду очень благодарен
Код:
//1 часть кода
unit TestMNKFunc;
interface
uses
//данная часть формируется средой Dеlphi ;
type
 TForm1 = class(TForm)
//данная часть формируется средой Dеlphi ;
 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;
 //
// Width:=ColWidths[0]+ColWidths[1]+ColWidths[2]+30;//StringGrid1
 // Chart1.Width:= form1.Width-Width;
 // Splitter1.Left:=Width;
 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.
-------------------------------------------------------------------------------
//2 часть кода

yPress(Sender: TObject; var Key: Char);
begin
 with sender as TLabeledEdit do
 begin
 if key=chr(vk_back) then exit; // chr(8)
 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; // chr(8)
 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 //одинаковые Xmax и Xmin
 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.
--------------------------------------------------------------
//3 часть кода
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. 
Ответить с цитированием
  #2  
Старый 03.01.2021, 13:22
Rosenkrantz Rosenkrantz вне форума
Активный
 
Регистрация: 04.12.2007
Адрес: Москва
Сообщения: 234
Версия Delphi: Delphi 7
Репутация: 40
По умолчанию

Могу. Кидайте полный проект. Он компилируется хоть? А то там в некоторых местах как-то весело написано.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 00:17.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter