Nugroho's blog.: [Delphi] Newton Method for Find a Root of a Function (just for self documentation)

Wednesday, June 4, 2014

[Delphi] Newton Method for Find a Root of a Function (just for self documentation)

Tadaa...

It's my Newton code in Delphi to find a root




unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
function fungsi(x:real):real;
begin fungsi:=x*x-3*x-4;end;
function turunan(x:real):real;
begin turunan:=2*x-3;end;
procedure newton;
var y1,ty1,x1,err:real;
n:integer;
ketemu:boolean;
begin
n:=0;err:=0.01;ketemu:=false;
x1:=strtofloat(form1.Edit1.Text);
while ketemu=false do begin
y1:=fungsi(x1);
ty1:=turunan(x1);
if y1=0 then begin
form1.Edit2.Text:='akarnya adalah '+ floattostr(x1);
ketemu:=true;end;
if abs(y1)<=err then begin
form1.Edit2.Text:='akarnya adalah '+ floattostr(x1);
ketemu:=true;end;
x1:= x1-(y1/ty1);n:=n+1;
form1.Edit3.Text:='langkah ke ' + inttostr(n);
application.ProcessMessages;sleep(100);
end;
end;
procedure gambar;
var x0,y0,y1,i:integer;
begin
x0:=round(form1.Image1.Width/2);
y0:=round(form1.Image1.Height/2);
with form1.Image1.canvas do begin
pen.Color:=clred;
moveto(0,y0);lineto(form1.Image1.Width,y0);
moveto(x0,0);lineto(x0,form1.Image1.Height);
end;
for i:=-100 to 150 do begin
y1:=round(fungsi(i/8));
form1.Image1.Canvas.Pixels[x0+i,y0-y1]:=clblue;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
gambar;
newton;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
button1.Caption:='newton';
edit1.Text:='0';

end;

end.

No comments:

323f (5) amp (1) android (12) apple (7) arduino (18) art (1) assembler (21) astina (4) ATTiny (23) blackberry (4) camera (3) canon (2) cerita (2) computer (106) crazyness (11) debian (1) delphi (39) diary (286) flash (8) fortran (6) freebsd (6) google apps script (8) guitar (2) HTML5 (10) IFTTT (7) Instagram (7) internet (12) iOS (5) iPad (6) iPhone (5) java (1) javascript (1) keynote (2) LaTeX (6) lazarus (1) linux (29) lion (15) mac (28) macbook air (8) macbook pro (3) macOS (1) Math (3) mathematica (1) maverick (6) mazda (4) microcontroler (35) mountain lion (2) music (37) netbook (1) nugnux (6) os x (36) php (1) Physicist (29) Picture (3) programming (189) Python (109) S2 (13) software (7) Soliloquy (125) Ubuntu (5) unix (4) Video (8) wayang (3) yosemite (3)