Advertisement
daniv1

Untitled

Nov 11th, 2017
123
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 4.57 KB | None | 0 0
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   Buttons;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BitBtn1: TBitBtn;
  17.     Button1: TButton;
  18.     Button2: TButton;
  19.     ComboBox1: TComboBox;
  20.     ComboBox2: TComboBox;
  21.     Edit1: TEdit;
  22.     Edit2: TEdit;
  23.     Edit3: TEdit;
  24.     Edit4: TEdit;
  25.     Edit5: TEdit;
  26.     Edit6: TEdit;
  27.     Label1: TLabel;
  28.     Label10: TLabel;
  29.     Label2: TLabel;
  30.     Label3: TLabel;
  31.     Label4: TLabel;
  32.     Label5: TLabel;
  33.     Label6: TLabel;
  34.     Label7: TLabel;
  35.     Label8: TLabel;
  36.     Label9: TLabel;
  37.     procedure Button1Click(Sender: TObject);
  38. procedure Button2Click(Sender: TObject);
  39.   private
  40.     { private declarations }
  41.   public
  42.     { public declarations }
  43.   end;
  44.  
  45. var
  46.   Form1: TForm1;
  47.  
  48. implementation
  49.  
  50. {$R *.lfm}
  51.  
  52. { TForm1 }
  53.  
  54.       Var a, b : Real; Kmax : Integer; m, k : Byte;
  55. Function f(x: Real; k1: Byte): Real;
  56. Begin
  57. Case k1 of
  58. 0: f := x * x - 4;
  59. 1: f := 3*x-4*ln(x)-5;
  60. End; end;
  61. Function fp (x, d: Real; k1: byte): Real; //First dif
  62. Begin
  63. fp := (f(x + d, k1) - f(x, k1)) / d;
  64. End;
  65. Function f2p (x, d:Real; k1:byte):Real; // Second dif
  66. Begin
  67. f2p:=(f(x + d, k1)+ f(x - d, k1)- 2 * f(x, k1)) / (d * d);
  68. End;
  69. Function MDP (a, b, Eps : Real; k1: byte; Var L : Integer ): Real;
  70. Var c, Fc : Real;
  71. Begin
  72. While ( b - a > Eps ) do
  73. Begin
  74. c := 0.5*(b - a) + a;
  75. L := L + 1; // counter of divisions[a, b]
  76. Fc := f(c, k1);
  77. If (Abs(Fc)< Eps) then // checking x*
  78. Begin
  79. MDP := c;
  80. Exit
  81. End;
  82. If F(a, k1) * Fc > 0 then a := c
  83. else b := c
  84. End;
  85. MDP := c; // end of MDP
  86. Exit end;
  87. Function MN (a, b, Eps : Real; k1: byte; Kmax: Integer; Var L : Integer): Real;
  88. Var x, Dx, D : Real;
  89. i : Integer;
  90. Begin
  91. Dx := 0.0; D := Eps / 100.0; x := b;
  92. If (f(x, k1) * f2p(x, D, k1) < 0) then x := a;
  93. If (f(x, k1) * f2p(x, d, k1) < 0) then
  94. ShowMessage('Для збіжність ітерацій не гарантована');
  95. For i:=1 to Kmax do
  96. Begin
  97. Dx := f(x, k1) / fp(x, D, k1); x := x - Dx;
  98. If (Abs(Dx) < Eps) then
  99. Begin
  100. MN := x;// Завершення роботи функції MN
  101. L := i;
  102. exit;
  103. end;
  104. end;
  105. ShowMessage('За задану кількість ітерацій кореня не знайдено'); exit;
  106. End;
  107. procedure TForm1.Button1Click(Sender: TObject);
  108. Var L : Integer; D, Eps : Real;
  109. Begin
  110. L := 0;
  111. // Перевірка правильності введення вхідних даних
  112. If Edit1.Text = '' then
  113. Begin
  114. ShowMessage ('Введіть число в Edit1');
  115. Exit; end;
  116. a := StrToFloat(Edit1.Text);
  117. If Edit2.Text = '' then
  118. Begin
  119. ShowMessage ('Введіть число в Edit2');
  120. Exit; end;
  121. b := StrToFloat(Edit2.Text);
  122. If Edit3.Text = '' then
  123. Begin
  124. ShowMessage ('Введіть число в Edit3');
  125. Exit; end;
  126. Eps := StrToFloat(Edit3.Text);
  127. If a > b then begin
  128. D := a; a := b; b := D; // Міняємо місцями a і b
  129. Edit1.Text := FloatToStr (a);
  130. Edit2.Text := FloatToStr (b); end;
  131. Case ComboBox1.ItemIndex of // Вибір методу :
  132. 0: m := 0; // метод ділення навпіл
  133. 1: Begin m := 1; D := Eps / 100.0;
  134. Label7.Visible := True; // Робимо видимим вікно для введення Kmax
  135. Edit4.Visible := True;
  136. End; end;
  137. Case ComboBox2.ItemIndex of// Вибір нелінійного рівняння
  138. 0: k := 0;
  139. 1: k := 1;
  140. end;
  141. If m = 0 then // Перевірка для МДН,
  142. If (F(a, k))* (F(b, k)) > 0 then // чи є корінь на інтервалі [a,b]
  143. Begin
  144. ShowMessage('Введіть правильний інтервал [a,b]!');
  145. Edit1.Clear;
  146. Edit2.Clear;
  147. Exit; end;
  148. If Abs(F(a, k)) < Eps then
  149. begin
  150. Edit5.Text := FloatToStr(a); Edit6.Text := IntToStr(L); exit;
  151. end;
  152. If Abs(F(b, k)) < Eps then
  153. begin
  154. Edit5.Text := FloatToStr(b);
  155. Edit6.Text := IntToStr(L);
  156. Exit end;
  157. Case m of
  158. 0: begin // Виклик методу ділення навпіл MDP
  159. Edit5.Text := FloatToStr (MDP(a, b, Eps, k, L));
  160. Edit6.Text := IntToStr (L);
  161. Label10.Caption := 'К-ть поділів ='; Exit end;
  162. 1: begin // Виклик методу Ньютона
  163. Kmax := StrToInt(Edit4.Text);
  164. Edit5.Text := FloatToStr (MN (a, b, Eps, k, Kmax, L));
  165. Edit6.Text := IntToStr (L);
  166. Label10.Caption := 'К-ть ітерац. ='; end;
  167. end;
  168. end;
  169. procedure TForm1.Button2Click(Sender: TObject);
  170. begin
  171. Edit1.Clear;
  172. Edit2.Clear;
  173. Edit3.Clear;
  174. Edit4.Clear;
  175. Edit5.Clear;
  176. Edit6.Clear;
  177. Case ComboBox1.ItemIndex of
  178. 0:begin
  179. Label7.Visible:=False;
  180. Edit4.Visible:=False;
  181. end;
  182. 1:begin
  183. Label7.Visible:=True;
  184. Edit4.Visible:=True;
  185. end;
  186. End;
  187. end;
  188. end.
  189.  
  190. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement