Nugroho's blog.

Wednesday, June 4, 2014

[Delphi] Linear and Quadratic Regression (just for self documentation)

The code below have the plots and graphs (linear and quadratic regression) included





unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Image1: TImage;
    Memo1: TMemo;
    procedure awal;
    procedure datamentah;
    procedure plotdata;
    procedure regresi;
    procedure kuadratis;
    procedure plotregresi;
    function f(x:real):real;
    function fk(x:real):real;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const n=40; skala=3;
var
  Form1: TForm1;
  x0,y0:integer;                              x,y:array[-n..n]of real;
  a,b:real;                                   c:array[1..3]of real;
  matrik:array[1..3,1..4]of real;
implementation

{$R *.dfm}
procedure tform1.kuadratis;
var sxi,sxi2,sxi3,sxi4,syi,syixi,syixi2:real;
i,j,k:integer;                                jml,simpan:real;
begin
sxi:=0;sxi2:=0;sxi3:=0;sxi4:=0;               syi:=0;syixi:=0;syixi2:=0;
{sigma xi} {sigma xi kuadrat}                 {sigma xi pangkat3} {sigma xi pangkat4}
{sigma yi} {sigma yi*xi}                      {sigma yi* xi*xi }
for i:=1 to n do begin
  sxi:=sxi+x[i];                              sxi2:=sxi2+x[i]*x[i];
  sxi3:=sxi3+x[i]*x[i]*x[i];                  sxi4:=sxi4+x[i]*x[i]*x[i]*x[i];
  syi:=syi+y[i];                              syixi:=syixi+y[i]*x[i];
  syixi2:=syixi2+                             y[i]*x[i]*x[i];
end;
{isi matrik}
matrik[1,1]:=n;                               matrik[1,2]:=sxi;
matrik[1,3]:=sxi2;                            matrik[1,4]:=syi;
matrik[2,1]:=sxi;                             matrik[2,2]:=sxi2;
matrik[2,3]:=sxi3;                            matrik[2,4]:=syixi;
matrik[3,1]:=sxi2;                            matrik[3,2]:=sxi3;
matrik[3,3]:=sxi4;                            matrik[3,4]:=syixi2;
{gaus naif}
for k:= 1 to 3 do begin
  for i:= k+1 to 3 do begin
    simpan:=matrik[i,k];
      if simpan=0 then begin end
        else begin
         for j:=k to 4 do
           matrik[i,j]:=
             matrik[i,j]/
              simpan*
                matrik[k,k]-
                  matrik[k,j];
                    end;
                      end;
                        end;
{subtitusi}
c[3]:=matrik[3,4]/matrik[3,3];for i:=2 downto 1 do begin jml:=0;for j:=i+1
to 3
do jml:=jml+matrik[i,j]*c[j]; c[i]:=(matrik[i,4]-jml)/matrik[i,i];end;
memo1.Lines.Append('c[1] = '+ floattostr(c[1]));
memo1.Lines.Append('c[2] = '+ floattostr(c[2]));
memo1.Lines.Append('c[3] = '+ floattostr(c[3]));
{plot kuadratis}
image1.Canvas.Pen.Color:=clred;
image1.Canvas.MoveTo(x0+round(x[-n]),y0-round(skala*fk(x[-n])));
for i:=-n to n do begin
image1.Canvas.lineto(x0+round(x[i]),y0-round(skala*fk(x[i])));
end;
end;

function tform1.fk(x:real):real;
begin
  fk:=c[1]+c[2]*x+c[3]*x*x;
end;

procedure tform1.regresi;
var i:integer;                                xix,xixx,rx,ry:real;
begin
  rx:=0;ry:=0;
  for i:=1 to n do begin
    rx:=rx+x[i];                              ry:=ry+y[i];
  end;
  rx:=rx/n;                                   ry:=ry/n;
  memo1.Lines.Append('rx = '+floattostr(rx)); memo1.Lines.Append('ry = '+floattostr(ry));
  xix:=0;                                     xixx:=0;
  for i:=1 to n do begin
    xix:=xix+(x[i]-rx)*(y[i]-ry);             xixx:=xixx+(x[i]-rx)*(x[i]-rx);
  end;
  b:=xix/xixx;                                memo1.Lines.Append('b = '+floattostr(b));
  a:=ry-b*rx;                                 memo1.Lines.Append('a = '+floattostr(a));
end;

procedure tform1.awal;
begin
  randomize;                                  memo1.Text:='';
  stringgrid1.Cells[0,0]:='x';                stringgrid1.Cells[1,0]:='y';
  stringgrid1.RowCount:=2;
  datamentah;
  plotdata;
  regresi;
  plotregresi;
  kuadratis;
end;

procedure tform1.plotregresi;
var px,py:real;
begin
  px:=-2*n;                                    py:=a+b*(-2*n);
  image1.Canvas.pen.Color:=cllime;
  image1.Canvas.MoveTo(x0+round(px),           y0-skala*round(py));
  px:=2*n;                                     py:=a+b*(2*n);
  image1.Canvas.lineTo(x0+round(px),y0-skala*  round(py));
  memo1.Lines.Append('fungsi regresi: y ='+    floattostrf(a,ffGeneral,2,4)+' + '+
  floattostrf(b,                               ffGeneral,2,4)+' x');
end;

procedure tform1.plotdata;
var i:integer;
begin
  x0:=round(image1.Width/2);                  y0:=round(image1.Height/2);
  image1.Canvas.MoveTo(0,y0);                 image1.Canvas.LineTo(image1.Width,y0);
  image1.Canvas.MoveTo(x0,0);                 image1.Canvas.LineTo(x0,image1.Height);
  for i:=-n to n do begin
    image1.Canvas.Pixels[x0+round(x[i]),y0-round(skala*y[i])]:=clblue;
  end;
end;
procedure tform1.datamentah;
var i:integer;
begin
  stringgrid1.RowCount:=2*n+1;
  for i:=-n to n do begin
    x[i]:=i;                                  y[i]:=f(x[i]);
    stringgrid1.Cells[0,i+n+1]:=floattostr(x[i]);
    stringgrid1.Cells[1,i+n+1]:=floattostr(y[i]);
  end;
end;

function tform1.f(x:real):real;
begin
  f:=x*x/32+random(20)-10;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  awal;
end;

end.

by at No comments:
Labels: ,

[Delphi] Differential of Function (just for self documentation)

Here the code, it have the graph of function and plot of it diferential (gradien) line



unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure proses;
    procedure awal;
    function f(x:real):real;
    function df(x:real):real;
    function fs(x,xs,ys,m:real):real;
    procedure gambar;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  dx:real=0.01;
  x0,y0:integer;
implementation

{$R *.dfm}

procedure tform1.awal;
begin
  {gambar sumbu}
  x0:=round(image1.Width/2);
  y0:=round(image1.Height/2);
  with image1.Canvas do begin
    moveto(0,y0);
    lineto(image1.Width,y0);
    moveto(x0,0);
    lineto(x0,image1.Height);
  end;
end;
function tform1.f(x:real):real;
begin
  f:=10*cos(x)+x;
end;
function tform1.df(x:real):real;
begin
  df:=(f(x+dx)-f(x))/dx;
end;
function tform1.fs(x,xs,ys,m:real):real;
var c:real;
begin
  c:=ys-m*xs;
  fs:=m*x+c;
end;

procedure tform1.gambar;
var i:integer;
x,y,x1,y1,m:real;
begin
//  image1.Canvas.TextOut(0,0,'f(x)=x^2-2x-8 memiliki gradien '+floattostrf(df(0),ffnumber,8,2)+' di x=0');
  image1.Canvas.TextOut(0,0,'f(x)=x^2-2x-8 memiliki gradien '+format('%8.2f',[df(0)])+' di x=0');
  with image1.Canvas do begin
    {gambar fungsi}
    for i:=-200 to 200 do begin
      x:=i/8;
      y:=f(x);
      x1:=(i+1)/8;
      y1:=f(x1);
      pen.Color:=clblue;
      moveto(x0+i,y0-round(y));
      lineto(x0+i+1,y0-round(y1));
    end;
    {gambar garis singgung}
    m:=df(0);
    for i:=-200 to 200 do begin
      x:=i/8;
      y:=fs(x,0,f(0),m);
      x1:=(i+1)/8;
      y1:=fs(x1,0,f(0),m);
      pen.Color:=cllime;
      moveto(x0+i,y0-round(y));
      lineto(x0+i+1,y0-round(y1));
    end;
  end;
end;
procedure tform1.proses;
begin
  awal;
  gambar;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  timer1.Enabled:=false;
  proses;
end;

end.
by at No comments:
Labels: ,

[Delphi] Gauss Naif Method (just for self documentation)

Here the code



unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const n=3;
var
  Form1: TForm1;
  a:array[1..n,1..n+1]of real;
  x:array[1..n]of real;
  kotak:array[1..n] of tedit;
  implementation

{$R *.dfm}

procedure bacamatrik;
var i,j:integer;
begin
  for i:=1 to n do begin
   for j:=1 to n+1 do begin
     a[i,j]:=strtofloat(form1.StringGrid1.Cells[j-1,i-1]);
  end;end;
end;

procedure tulismatrik;
var i,j:integer;
begin
  for i:=1 to n do begin
   for j:=1 to n+1 do begin
     form1.StringGrid2.Cells[j-1,i-1]:=floattostr(a[i,j]);
  end;end;
end;

procedure naif;
var i,j,k:integer;
simpan:real;
begin
  for k:= 1 to n do begin
    for i:= k+1 to n do begin
       simpan:=a[i,k];
       if simpan=0 then begin
       end else begin
         for j:=k to n+1 do a[i,j]:=a[i,j]/simpan*a[k,k]-a[k,j];
       end;
    end;
  end;
end;
procedure subtitusi;
var i,j:integer;
jml:real;
begin
  x[n]:=a[n,n+1]/a[n,n];
  for i:=n-1 downto 1 do begin
    jml:=0;
    for j:=i+1 to n do jml:= jml+a[i,j]*x[j];
    x[i]:=(a[i,n+1]-jml)/a[i,i];
  end;
end;
procedure buatedit;
var i:integer;
begin
  for i:=1 to n do begin
    kotak[i]:=tedit.Create(form1);
    kotak[i].Left:=300;
    kotak[i].Top:=40+30*i;
    kotak[i].Parent:=form1;
  end;
end;
procedure isiedit;
var i:integer;
begin
  for i:=1 to n do kotak[i].Text:=floattostr(x[i]);
end;

procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
  randomize;
  stringgrid1.RowCount:=n;
  stringgrid2.RowCount:=n;
  stringgrid1.ColCount:=n+1;
  stringgrid2.ColCount:=n+1;
  for i:=1 to n do begin
    for j:=1 to n+1 do begin
       a[i,j]:=random(20)-10;
       stringgrid1.Cells[j-1,i-1]:=floattostr(a[i,j]);
  end;end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  bacamatrik;
  naif;
  subtitusi;
  tulismatrik;
  buatedit;
  isiedit;
end;

end.

by at No comments:
Labels: ,

[Delphi] Write to File (just for self documentation)

Here the code, the input method is still manual though, :)



unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button6: TButton;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Button7: TButton;
    procedure proses;
    procedure simpanfile;
    procedure simpanrecord;
    procedure bacarecord;
    procedure simpan;
    procedure tampilkan;
    procedure awal;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  tmahasiswa = record
    nama,nim,alamat,offering,nhuruf:string[30];
    umur:integer;
    nilai:real;
  end;
var
  Form1: TForm1;
  fileku:textfile;
  files: file of tmahasiswa;
  mahasiswa: tmahasiswa;
implementation

{$R *.dfm}
procedure tform1.awal;
begin
  edit1.Text:='Nama';
  edit2.Text:='NIM';
  edit3.Text:='18';{umur}
  edit4.Text:='Alamat';
  edit5.Text:='Offering';
  edit6.Text:='81';{nilai}
  edit7.Text:='Nilai Huruf';

  button6.Caption:='Simpan';
  button7.Caption:='Tampilkan';
end;
procedure tform1.simpan;
begin
  assignfile(files,'data.mp4');
  reset(files);
  mahasiswa.nama:=edit1.Text;
  mahasiswa.nim:=edit2.Text;
  mahasiswa.umur:=strtoint(edit3.Text);
  mahasiswa.alamat:=edit4.Text;
  mahasiswa.offering:=edit5.Text;
  mahasiswa.nilai:=strtofloat(edit6.Text);
  mahasiswa.nhuruf:=edit7.Text;

  seek(files,filesize(files));
  write(files,mahasiswa);
  closefile(files);
end;
procedure tform1.tampilkan;
begin memo1.Text:='';bacarecord;end;
procedure TForm1.Button6Click(Sender: TObject);
begin simpan; end;
procedure TForm1.Button7Click(Sender: TObject);
begin tampilkan;end;

procedure tform1.bacarecord;
var text:string;
begin
  assignfile(files,'data.mp4');
  //filemode:=fmopenread;
  reset(files);
  while not eof(files) do begin
    read(files,mahasiswa);
    text:=mahasiswa.nama+' ('+inttostr(mahasiswa.umur)+') '+mahasiswa.nim+' '+mahasiswa.alamat+' '+mahasiswa.offering+' '+floattostr(mahasiswa.nilai)+' ('+mahasiswa.nhuruf+')';
    memo1.Lines.Append(text);
  end;

  closefile(files);

end;
procedure tform1.simpanrecord;
begin
  assignfile(files,'data.mp4');
  rewrite(files);

  mahasiswa.nama:='string';
  mahasiswa.nim:='001';
  mahasiswa.alamat:='malang';
  mahasiswa.offering:='abc';
  mahasiswa.nhuruf:='wow+';
  mahasiswa.umur:=20;
  mahasiswa.nilai:=60;
  write(files,mahasiswa);

  mahasiswa.nama:='qwerty';
  mahasiswa.nim:='002';
  mahasiswa.alamat:='malang';
  mahasiswa.offering:='abc';
  mahasiswa.nhuruf:='wow';
  mahasiswa.umur:=22;
  mahasiswa.nilai:=55;
  write(files,mahasiswa);

  mahasiswa.alamat:='tidak di malang';
  mahasiswa.offering:='abc';
  mahasiswa.nhuruf:='wow-';
  mahasiswa.umur:=18;
  mahasiswa.nilai:=55;
  write(files,mahasiswa);

  mahasiswa.nama:='dvorak';
  mahasiswa.nim:='004';
  mahasiswa.alamat:='batu';
  mahasiswa.offering:='nyasar';
  write(files,mahasiswa);

  closefile(files);

end;
procedure tform1.simpanfile;
var i:integer;
begin
  assignfile(fileku,'filesaya.txt');
  rewrite(fileku);

  write(fileku,'Hello ');
  write(fileku,'world');

  writeln(fileku);
  for i:=1 to 10 do begin
    write(fileku, i/2, ' ' );
    //writeln(fileku);
  end;

  writeln(fileku);

  for i:=1 to 10 do begin
    write(fileku, i/2:5:1, ' ' );
    //writeln(fileku);
  end;


  closefile(fileku);


end;

procedure tform1.proses;
var i:integer;
begin
  memo1.Text:='';
  for i:=1 to 10 do begin
    memo1.Lines.Append('OK, ini adalah baris ke-'+inttostr(i));
  end;
  memo1.Lines.Strings[5-1]:='dengan';
  {}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  proses;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  simpanfile;
end;

procedure TForm1.Button3Click(Sender: TObject);
var text:string;
begin
  assignfile(fileku,'filesaya.txt');
  reset(fileku);
  while not eof(fileku) do begin
    readln(fileku,text);
    memo1.Lines.Append(text);
  end;
  closefile(fileku);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  simpanrecord;

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
   bacarecord;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  awal;
end;

end.

<\pre>
by at No comments:
Labels: ,

[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.

by at No comments:
Labels: ,

Friday, May 30, 2014

Bouncing Ball using Python on iPhone

Here the code

I use Pythonista on iOS



class MyScene (Scene):
  def setup(self):
    self.x=10.
    self.y=10.
    self.vx=137.
    self.vy=153.
    self.dt=1/64
    pass
  def draw(self):
    background(1,1,1)
    fill(0,1,0)
    if(self.x>=self.size.w)or(self.x<=0):
      self.vx*=-1
    if(self.y>=self.size.h)or(self.y<=0):
      self.vy*=-1
    
    self.x+=self.vx*self.dt
    self.y+=self.vy*self.dt

    ellipse(self.x,self.y,10,10)

run(MyScene())
by at No comments:

Game of Life using Python on iPhone

Here the Game of Life code using Python in iOS.

I use Pythonista


from scene import *

from random import choice

class MyScene (Scene):

  def setup(self):
    # This will be called before the first frame is drawn
    self.jalan=-1
    self.m =[]
    self.n=[]

    for i in range(0,32):
      self.m.append([])
      self.n.append([])
      for j in range(0,48):
        self.n[i].append(choice([0,1]))
        self.m[i].append(0)

  def neigh(self,i,j):
    n=self.n
    sum = n[i-1][j-1]+n[i-1][j]+n[i-1][j+1]+n[i][j-1]+n[i][j+1]+n[i+1][j-1]+n[i+1][j]+n[i+1][j+1]
    return sum

  def liveOrDie(self,i,j,count):
    if(self.n[i][j]==0):
      if(count==3):
        self.m[i][j]=1
      else:
        self.m[i][j]=0
    else:
      if((count > 3)or(count < 2)):
        self.m[i][j]=0
      else:
        self.m[i][j]=1

    self.n[i][j]=self.m[i][j]

  def drawCell(self):
    background(0,.5,0) 
    for i in range(0,32):
      for j in range(0,48): 
        if (self.n[i][j]==0):
          fill(0,.1,0)
        else:
          fill(0,1,0)

        ellipse(i*10,j*10,10,10)

  def draw(self):
    for i in range(1,31):
      for j in range(1,47):
        count=self.neigh(i,j)
        self.liveOrDie(i,j,count) 

    self.drawCell() 

run(MyScene(),frame_interval=2 )
by at No comments:
Subscribe to: Posts (Atom)
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)