Gistrec

delphi интеграл монте-карло

May 24th, 2017
492
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 3.61 KB | None | 0 0
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, rxParsing, Rxtconst;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Edit: TEdit;
  12.     Button: TButton;
  13.     NameGraph: TLabel;
  14.     Graph: TImage;
  15.     xFrom: TEdit;
  16.     xTo: TEdit;
  17.     LabelFrom: TLabel;
  18.     LabelTo: TLabel;
  19.     IntegrateLabel: TLabel;
  20.     procedure OnClick(Sender: TObject);
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.dfm}
  29.  
  30. function integrate(formula: String; xFrom: Integer; xTo: Integer; count: Integer): Extended;
  31. var
  32.   i: Integer;
  33.   Res: Extended; // Результат
  34.   x: Integer;
  35.   newFormula: String;
  36. begin
  37.   Res := 0;
  38.   Randomize();
  39.   // Собственно вычисляем интеграл Монте Карло
  40.   for i := 1 to count do begin
  41.     //x := Random(2 * (xTo - xFrom)) - (xFrom - xTo);
  42.     x := Random(xTo - xFrom + 1) + xFrom;
  43.     newFormula := stringreplace(formula, 'x', IntToStr(x), [rfReplaceAll, rfIgnoreCase]);
  44.     Res := Res + rxParsing.GetFormulaValue(newFormula);
  45.   end;
  46.   Res := Res  / count;
  47.   // Возвращяем результат
  48.   Exit(Res);
  49. end;
  50.  
  51. function drowLines(Graph : TImage): Integer;
  52. begin
  53.   // Ось Y
  54.   Graph.Canvas.Pen.Color := RGB(255, 255, 255);
  55.   Graph.Canvas.LineTo(Round(Graph.Width / 2), 0);
  56.   Graph.Canvas.Pen.Color := RGB(255, 60, 255);
  57.   Graph.Canvas.LineTo(Round(Graph.Width / 2), Graph.Height);
  58.   // Ось X
  59.   Graph.Canvas.Pen.Color := RGB(255, 255, 255);
  60.   Graph.Canvas.LineTo(0, Round(Graph.Height / 2));
  61.   Graph.Canvas.Pen.Color := RGB(255, 60, 255);
  62.   Graph.Canvas.LineTo(Graph.Width + 100, Round(Graph.Height / 2));
  63.   Exit(0);
  64. end;
  65.  
  66. procedure TForm1.OnClick(Sender: TObject);
  67. var
  68.   x: Integer;
  69.   formula: String;
  70.   newFormula: String;
  71.   y: Extended;
  72.   integral: Extended;
  73. begin
  74.   // Стираем наше поле
  75.   Graph.Canvas.FillRect(Graph.Canvas.ClipRect);
  76.   // Чертим линии oX oY
  77.   drowLines(Graph);
  78.  
  79.   // Основная формула, в которой есть 'x'
  80.   // Позже мы будем заменять 'x' на 'x + значение функции'
  81.   formula := Edit.Text;
  82.  
  83.   // Установка ширины рисования
  84.   Graph.Canvas.Pen.Width := 3;
  85.  
  86.   // Устанавливаем точку, от кторой будем чертить в начало нашей функции
  87.   // Нужно, чтобы не было линии из 0:0 к началу черчения
  88.   Graph.Canvas.Pen.Color := RGB(255, 255, 255);
  89.   Graph.Canvas.LineTo(999, 999);
  90.   x := Round(Graph.Width / 2) + StrToInt(xFrom.Text);
  91.   newFormula := stringreplace(formula, 'x', IntToStr(x - Round(Graph.Width / 2)), [rfReplaceAll, rfIgnoreCase]);
  92.   y := Round(Graph.Height / 2) - rxParsing.GetFormulaValue(newFormula);
  93.   Graph.Canvas.LineTo(x, Round(y));
  94.    
  95.   Graph.Canvas.Pen.Color := RGB(60, 255, 60);
  96.  
  97.   // Чертим наш график :)
  98.   for x := Round(Graph.Width / 2) + StrToInt(xFrom.Text) to Round(Graph.Width / 2) + StrToInt(xTo.Text) do
  99.   begin
  100.     newFormula := stringreplace(formula, 'x', IntToStr(x - Round(Graph.Width / 2)), [rfReplaceAll, rfIgnoreCase]);
  101.     y := Round(Graph.Height / 2) - rxParsing.GetFormulaValue(newFormula);
  102.     Graph.Canvas.LineTo(x, Round(y));
  103.   end;
  104.  
  105.   // Вызываем функцию для интегрирования :)
  106.   Integral := integrate(formula, StrToInt(xFrom.Text), StrToInt(xTo.Text), 10000);
  107.   // Изменяем текст
  108.   IntegrateLabel.Caption := 'Интеграл: ' + FloatToStr(Integral);
  109. end;
  110.  
  111. end.
Advertisement