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.