Convex Hull merupakan persoalan klasik dalam geometri komputasional. Persoalan ini saya ketahui pertama kali ketika lomba pemrograman waktu SMA. Persoalannya digambarkan secara sederhana dalam ruang dimensi dua (bidang) sebagai mencari subset dari himpunan titik pada bidang tersebut sedemikian rupa sehingga jika titik-titik tersebut dijadikan poligon maka akan membentuk poligon yang konveks. Suatu poligon dikatakan konveks jika digambarkan garis yang menghubungkan antar titik maka tidak ada garis yang memotong garis yang menjadi batas luar poligon. Definisi lain dari convex hull adalah poligon yang disusun dari subset titik sedemikian sehingga tidak ada titik dari himpunan awal yang berada di luar poligon tersebut (semua titik berada di batas luar atau di dalam area yang dilingkupi oleh poligon tersebut).

convex hull

Petunjuk untuk menyelesaikan persoalan ini adalah persamaan garis pada bidang. Persamaan garis pada bidang memisahkan bidang menjadi dua bagian yaitu area di sebelah kanan bidang (relatif terhadap orientasi garis). Sebagai contoh garis berorientasi adalah sumbu koordinat. Misalkan saja sumbu vertikal (ordinat, arah orientasi ke atas), seluruh titik di sebelah kanan garis ini memiliki nilai komponen koordinat horizontal (X) yang positif sedangkan seluruh titik di sebelah kiri garis memiliki nilai komponen koordinat horizontal negatif.

Petunjuk di atas dimanfaatkan dengan membuat definisi bahwa garis yang dibentuk oleh titik-titik poligon jika diasumsikan memiliki orientasi yang sama, maka setiap titik berada di sebelah kanan seluruh garis batas tersebut. Definisi ini kemudian dimanfaatkan untuk menentukan aksi awal yaitu memilih titik yang berada paling luar pertama. Mencari titik pertama cukup mudah yaitu cukup memilih titik yang memiliki nilai komponen koordinat (horizontal atau vertikal) yang ekstrim (minimum atau maksimum). Titik-titik convex hull lainnya ditentukan berdasarkan titik pertama tadi.

Algoritma awal yang intuitif dari deskripsi paragraf sebelumnya adalah.

Algoritma tersebut menggunakan pendekatan exhaustive (brute-force). kompleksitas algoritma tersebut mendekati O(n²). Algoritma tersebut dapat dioptimasi dengan membuat agar kumpulan titik-titik tersebut terurut secara lexicografis (urutkan dulu berdasarkan koordinat sumbu-X lalu untuk koordinat pada sumbu-X yang sama urutkan berdasarkan koordinat pada sumbu-Y). Sifat keterurutan ini kemudian dimanfaatkan sehingga pada setiap fase tiap titik hanya dikunjungi satu kali (kompleksitas linier). Adapun fase-fase yang perlu dilalui terdiri dari dua fase yaitu batas bagian atas (upper boundary) dan batas bagian bawah (lower boundary). Misal pada contoh algoritma berikut :

procedure TForm1.ConvexHull( ap: array of TPoint );
var

  pi                : array of integer;
  hull              : array of integer;
  h, i, j, k, l     : integer;
  dx, dy, dx2, dy2  : integer;
  found             : boolean;
begin
  { initialize index }
  setlength( pi, length( ap ) );
  for i := 0 to high( pi ) do
    pi[i] := i;

  { sort the index lexicographically, shown here using simple quadratic complexity sort algorithm }
  for i := 0 to high( pi ) - 1 do begin
    for j := i + 1 to high( pi ) do begin
      if ( ap[pi[j]].X < ap[pi[i]].X ) or ( ( ap[pi[j]].X < ap[pi[i]].X ) and ( ap[pi[j]].Y > ap[pi[i]].Y ) ) then begin
        k := pi[j];
        pi[j] := pi[i];
        pi[i] := k;
      end;
    end;
  end;

  { build upper boundary }
  setlength( hull, 2 );
  hull[0] := pi[0];
  hull[1] := pi[1];
  h := 1;

  for i := 2 to high( pi ) do begin
    found := false;
    for k := 1 to high( hull ) do begin
      dx := ap[hull[k]].X - ap[hull[k - 1]].X;
      dy := ap[hull[k]].Y - ap[hull[k - 1]].Y;

      dx2 := ap[pi[i]].X - ap[hull[k]].X;
      dy2 := ap[pi[i]].Y - ap[hull[k]].Y;

      j := dy * dx2 - dx * dy2;
      { delete previous non-convex edge w.r.t current point }
      if j > 0 then begin
        hull[k] := pi[i];
        setlength( hull, k + 1 );
        found := true;
        break;
      end;
    end;

    { add if current point lies on the right side of previous upper edges }
    if not found then begin
      setlength( hull, length( hull ) + 1 );
      hull[high( hull )] := pi[i];
    end;
  end; 

  { build lower boundary }
  h := high( hull ) - 1;
  for i := high( pi ) downto 0 do begin
    found := false;
    for k := h to high( hull ) do begin
      dx := ap[hull[k]].X - ap[hull[k - 1]].X;
      dy := ap[hull[k]].Y - ap[hull[k - 1]].Y;

      dx2 := ap[pi[i]].X - ap[hull[k]].X;
      dy2 := ap[pi[i]].Y - ap[hull[k]].Y;

      j := dy * dx2 - dx * dy2;
      if j > 0 then begin
        hull[k] := pi[i];
        setlength( hull, k + 1 );
        found := true;
        break;
      end;
    end;

    if not found then begin
      setlength( hull, length( hull ) + 1 );
      hull[high( hull )] := pi[i];
    end;
  end;

  { display result }
  Image1.Canvas.Pen.Color := clLime;
  Image1.Canvas.MoveTo( ap[hull[0]].X, ap[hull[0]].Y );
  for i := 1 to high( hull ) do
    Image1.Canvas.LineTo( ap[hull[i]].X, ap[hull[i]].Y );
  for i := 0 to high( hull ) do
    drawpt( ap[hull[i]].X, ap[hull[i]].Y, clRed );

end;

Algoritma di atas terdiri dari tiga bagian yaitu pengurutan titik, penyusunan batas bagian atas, dan penyusunan batas bagian bawah. Pada contoh di atas kompleksitas ditentukan oleh algoritma pengurutan titik yang cenderung kuadratik (O(n²)) untuk mempermudah pemahaman, jika dibutuhkan algoritma pengurutan dapat menggunakan algoritma yang memiliki kompleksitas lebih rendah/linearitmik (O(n.log n)).

Prosesor multicore sudah tidak asing tetapi aplikasi yang umumnya dikembangkan biasanya hanya terdiri dari satu thread. Sejak dahulu ternyata sudah ada Win32 API untuk menentukan afinitas proses/thread ke prosesor tertentu. Kode di bawah menggunakan delphi 7.

Mendapatkan Jumlah core/Prosesor

var
  sinfo : TSystemInfo;
begin
  GetSystemInfo(sinfo);
  { jumlah prosesor ada di field dwNumberOfProcessors }
  showmessage(inttostr(sinfo.dwNumberOfProcessors));

Menentukan Afinitas ke core tertentu
Afinitas ke core menggunakan bit vector. Tiap 1 bit diasosiasikan ke core tertentu mulai dari LSB. karena tipe data yang dilemparkan ke fungsi tsb adalah 32 bit unsigned integer maka mungkin maksimum prosesor yang bisa diakses sejumlah 32.

berikut ini contoh kode agar aplikasi yang sedang berjalan hanya menggunakan core pertama (cpu0) saja.

SetProcessAffinityMask(GetCurrentProcess, 1);

berikut ini contoh kode agar aplikasi yang sedang berjalan hanya menggunakan core pertama (cpu0) dan kedua (cpu1).

SetProcessAffinityMask(GetCurrentProcess, 3);

sedangkan berikut ini contoh kode agar aplikasi yang sedang berjalan hanya menggunakan core kedua (cpu0) saja.

SetProcessAffinityMask(GetCurrentProcess, 2);

*duh, dah lama nggak update blog saking sibuknya (cari alesan)*

Beberapa waktu yang lalu ada permintaan untuk melakukan encoding/decoding ke format base64. karena waktu yang mendesak dan jumlah item requirement yang banyak maka alternatif pertama adalah mencari kode public domain di internet. ternyata tidak satupun yang bisa dipakai (pada saat yang sempit itu). hambatannya bermacam-macam, mulai dari hasil encoding yang tidak sesuai, atau hasil decoding yang beda dengan acuan. setelah duduk sebentar sambil melototin lagi halaman wikipedia yang mendeskripsikan aturan pengkodean basis64 akhirnya langkah terakhir malah bikin sendiri fungsi yang sesuai dengan spek (teks dari/ke base64, binary(variabel bertipe ataupun byte stream) dari/ke base64).

bagi yang berminat menggunakan, dipersilakan menggunakan kode berikut sebebas-bebasnya (pubdom as no warranty for using).

(*
 * auth : Peb Ruswono Aryan
 * desc : base64 encoding/decoding for delphi
 *)
type
  tbytearr = array of byte;

{
	encode64 : Pointer x Nat --> string
	desc: encode binary data to base64 message
}
function encode64( const v: Pointer; vsize: cardinal ): string;
const
  lut64             = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var
  tribyte           : array[0..2] of byte;
  p                 : PByteArray;
  ci, i             : cardinal;

  function enc3byteto4char( len: integer ): string;
  begin
    result := lut64[1 + tribyte[0] shr 2];
    result := result + lut64[1 + ( ( tribyte[0] and $03 ) shl 4 ) + ( tribyte[1] shr 4 )];
    if len > 1 then
      result := result + lut64[1 + ( tribyte[1] and $0F ) shl 2 + ( tribyte[2] shr 6 )]
    else
      result := result + '=';
    if len > 2 then
      result := result + lut64[1 + tribyte[2] and $3F]
    else
      result := result + '=';
  end;
begin
  p := PByteArray( v );
  ci := 0;
  repeat
    i := 0;
    while i < 3 do begin
      if ci >= vsize then break;
      tribyte[i] := p[ci];
      inc( ci );
      inc( i );
    end;
    result := result + enc3byteto4char( i );
  until ci >= vsize;
end;

{
	decode64 : String --> DynamicArray of byte
	desc: decode base64message to binary data (array of byte)
}
function decode64( msg: string ): TbyteArr;
var
  pb                : array of byte;
  lm, pi            : integer;
  len               : integer;

  function decodechar( c: char; var code: byte ): boolean;
  begin
    result := true;
    case c of
      'A'..'Z': code := ord( c ) - ord( 'A' );
      'a'..'z': code := ord( c ) - ord( 'a' ) + 26;
      '0'..'9': code := ord( c ) - ord( '0' ) + 52;
      '+': code := 62;
      '/': code := 63;
    else
      result := false;
    end;
  end;

  procedure decodeblock( blk: string );
  var
    t, i            : byte;
    w               : dword;
  begin
    w := 0;
    i := 0;
    while i < 4 do begin
      if not decodechar( blk[i + 1], t ) then break;
      w := w shl 6 + t;
      inc( i );
    end;
    result[pi] := ( w shr 16 ) and $FF;
    inc( pi );
    if pi >= len then exit;
    result[pi] := ( w shr 8 ) and $FF;
    inc( pi );
    if pi >= len then exit;
    result[pi] := ( w and $FF );
    inc( pi );
  end;
begin
  len := length( msg ) * 3 div 4;
  lm := length( msg );
  if msg[lm] = '=' then dec( len );
  if msg[lm - 1] = '=' then dec( len );
  setlength( result, len );
  pi := 0;
  repeat
    decodeblock( copy( msg, 1, 4 ) );
    delete( msg, 1, 4 );
  until length( msg ) <= 0;
end;

{
	encode64str : string --> string
	desc: encode text string into base64 message
}
function encode64str( msg: string ): string;
var
  p                 : TByteArr;
  i                 : integer;
begin
  setlength( p, length( msg ) );
  for i := 0 to high( p ) do
    p[i] := ord( msg[i + 1] );
  result := encode64( @p[0], length( p ) );
end;

{
	decode64str : string --> string
	desc: decode base64 message containing text
}
function decode64str( msg: string ): string;
var
  p                 : TByteArr;
  i                 : integer;
begin
  result := '';
  p := decode64( msg );
  for i := 0 to length( p ) do
    result := result + chr( p[i] );
end;

Terinspirasi dengan tulisan tentang memasang sendiri sistem cctv dengan zoneminder saya jadi iseng membuat sistem serupa (bukan memasang lagi, ini membuat). Awalnya memang tidak berniat untuk ke arah sana, hanya ingin melakukan interpretasi citra dengan memanfaatkan webcam, tapi kemudian terhambat karena framerate yang lambat ketika awal-awal mencoba.

Pendahuluan

Oke, mari dimulai percobaannya. Spesifikasi kita kali ini adalah membuat sistem cctv yang mengambil gambar dari webcam dan dapat diakses melalui web server (ujung yang cukup generik, bisa diperluas dengan membuat mobile client yang mengakses http ). Selain itu tiap gambar diarsipkan sehingga memungkinkan untuk pemrosesan yang tidak membutuhkan tenggat. Agar lebih sederhana, kita akan mendekomposisi sistem yang kita buat menjadi 3 modul :

1. program pengakses webcam (GUI).
2. program perantara (CLI, bisa jadi opsional, nanti akan dijelaskan alasannya).
3. halaman web (HTML+PHP)

Alat dan Bahan
Berikutnya alat yang diperlukan :

• web server (saya menggunakan xampp 1.5). modul yang diperlukan sebetulnya hanya apache dan php. database tidak diperlukan saat ini untuk menyederhanakan program.
• compiler delphi (anda bisa menggunakan apapun sebetulnya, tapi saya menggunakan delphi)
• A win32 machine. ya ya.. saya pakai API Windows tapi nggak pakai DirectX, cuma pakai VFW (Video for Windows). stok lama.
• Webcam. USB atau apapun. sekali-lagi, demi kesederhanaan, saya hanya menggunakan 1 webcam (default) yang ada di laptop.

Arsitektur sistem
gambaran umum sistem bisa dilihat dalam gambar berikut.

Program 1,2, dan 3 sesuai dengan penjelasan di awal.

Program 1

Program ini dibuat menggunakan delphi dan terdiri dari 1 modul webcam dan 1 form. berikut ini kode untuk unit pengakses webcam (konstanta dan prosedur sudah di-dietkan supaya hanya mengandung yang diperlukan saja).

unit _cam;

interface

uses
  Windows,
  Messages,
  Controls,
  ExtCtrls;

const
  WM_CAP_START      = WM_USER;
  WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
  WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
  WM_CAP_SAVEDIB    = WM_CAP_START + 25;
  WM_CAP_COPY       = WM_CAP_START + 30;
  WM_CAP_SET_SCALE  = WM_CAP_START + 53;
  WM_CAP_SET_PREVIEW = ( WM_CAP_START + 50 );
  WM_CAP_SET_OVERLAY = ( WM_CAP_START + 51 );
  WM_CAP_SET_PREVIEWRATE = ( WM_CAP_START + 52 );

type
  TCam = class
  protected
    hWndC: HWND;
    FIsCapturing: Boolean;
    procedure BeginCapture( Container: TWinControl );
    procedure EndCapture;
  public
  	constructor Create( Container: TWinControl );
    destructor Free;
  	property Handle:HWND read hwndc;
  	property Capturing:boolean read FIsCapturing;
    procedure CopyToClipboard;
    procedure SaveToFile( filename: string );
  end;

implementation

uses
  ClipBrd;

function capCreateCaptureWindowA( lpszWindowName: PCHAR;
  dwStyle: longint;
  x: integer;
  y: integer;
  nWidth: integer;
  nHeight: integer;
  ParentWin: HWND;
  nId: integer ): HWND; stdcall external
'AVICAP32.DLL';

{ TCam }

procedure TCam.BeginCapture( Container: TWinControl );
begin
  hWndC := capCreateCaptureWindowA( 'Capture Window',
    WS_CHILD or WS_VISIBLE,
    Container.Left,
    Container.Top,
    Container.Width,
    Container.Height,
    Container.Handle,
    0 );
  if hWndC <> 0 then begin
    SendMessage( hWndC, WM_CAP_DRIVER_CONNECT, 0, 0 );
    SendMessage( hWndC, WM_CAP_SET_SCALE, 1, 0 );
    SendMessage( hWndC, WM_CAP_SET_PREVIEWRATE, 24, 0 );
    SendMessage( hWndC, WM_CAP_SET_PREVIEW, 1, 0 );
    FIsCapturing := True;
  end;
end;

procedure TCam.CopyToClipboard;
begin
	if hWndC <> 0 then begin
    SendMessage( hwndc, WM_CAP_COPY, 0, 0 );
  end;
end;

procedure TCam.EndCapture;
begin
	FIsCapturing := False;
	if hWndC <> 0 then begin
    SendMessage( hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0 );
    hWndC := 0;
  end;
end;

procedure TCam.SaveToFile( filename: string );
begin
  if hWndC <> 0 then begin
    SendMessage( hWndC,
      WM_CAP_SAVEDIB,
      0,
      longint( pchar( filename ) )
      );
  end;
end;

constructor TCam.Create(Container: TWinControl);
begin
	inherited Create;
	BeginCapture(Container);
end;

destructor TCam.Free;
begin
	EndCapture;
end;

end.

sedangkan kode untuk formnya adalah sebagai berikut. satu hal yang perlu diperhatikan. form berikut saya buat StayOnTop karena kalau di-minimize atau tersembunyi, gambarnya tidak akan di-update. Hal lainnya adalah pengaturan webcam agar bisa didapat framerate yang tinggi (di laptop saya setelah beberapa fitur dimatikan seperti low-light boost dan color boost baru bisa berjalan di 25 FPS).

//unit1.dfm
object Form1: TForm1
  Left = 192
  Top = 107
  BorderStyle = bsDialog
  Caption = 'Form1'
  ClientHeight = 241
  ClientWidth = 321
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  FormStyle = fsStayOnTop
  OldCreateOrder = False
  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 320
    Height = 240
    BevelOuter = bvNone
    Color = clBlack
    TabOrder = 0
  end
  object _proc: TTimer
    Enabled = False
    Interval = 48
    OnTimer = _procTimer
    Left = 56
    Top = 16
  end
end

dan code-behind-nya adalah sebagai berikut.

unit Unit1;

interface
uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  MPlayer,
  StdCtrls,
  citra,
  Spin,
  ClipBrd,
  _cam,
  jpeg,
  inifiles;

type
  TForm1 = class( TForm )
    Panel1: TPanel;
    _proc: TTimer;
    procedure FormCreate( Sender: TObject );
    procedure FormCloseQuery( Sender: TObject; var CanClose: Boolean );
    procedure _procTimer( Sender: TObject );
  private
    cam: TCam;
    bmp: TBitmap;
    jpg: TJpegImage;
    ini: TIniFile;
  public
  end;

var
  Form1             : TForm1;
  capmode           : integer;
  datapath          : string;

implementation
{$R *.DFM}

{ TForm1 }

procedure TForm1.FormCreate( Sender: TObject );
begin
  ini := TIniFile.Create( extractfilepath( application.ExeName ) + 'config.ini' );
  capmode := ini.ReadInteger( 'server', 'mode', 0 );
  if capmode = 2 then begin
    datapath := ini.ReadString( 'server', 'datadir', 'data' );
    if pos( ':', datapath ) = 0 then datapath := extractfilepath( application.ExeName ) + datapath;
  end;
  jpg := TJpegImage.Create;
  jpg.CompressionQuality := ini.ReadInteger('server','jpegquality', 40);
  _proc.Interval := 1000 div ini.ReadInteger('server', 'fps', 5);
  bmp := TBitmap.Create;
  if not Assigned( cam ) then cam := TCam.Create( Panel1 );
  _proc.Enabled := cam.Capturing;
end;

procedure TForm1.FormCloseQuery( Sender: TObject; var CanClose: Boolean );
begin
  CanClose := False;
  _proc.Enabled := false;
  jpg.Free;
  bmp.Free;
  if Assigned( cam ) then cam.Free;
  CanClose := True;
end;

procedure TForm1._procTimer( Sender: TObject );
begin
  if cam.Capturing then begin
    if capmode > 0 then begin
      cam.CopyToClipboard;
      if capmode = 2 then begin
        bmp.Assign( clipboard );
        jpg.Assign( bmp );
        jpg.SaveToFile( format( '%s\%.12d.jpg', [datapath, gettickcount] ) );
      end;
    end;
  end;
end;

end.

Program di atas akan menyimpan hasil rekaman dari webcam ke dalam file dalam format JPEG yang kualitasnya dapat diparameterkan sehingga ukuran file keluarannya dapat juga diatur. Nama file rekaman menggunakan gettickcount yang dikodekan menjadi string sepanjang 12 digit. Penggunaan angkan dimaksudkan agar memudahkan dalam mencari file terakhir tanpa harus menggunakan database. Untuk sementara semua hasil rekaman dari webcam disimpan dalam satu direktori (datadir). Selanjutnya bisa menggunakan struktur direktori yang mencerminkan tanggal (YYYY\MM\DD\) untuk memudahkan pengarsipan.
program di atas menggunakan file konfigurasi dengan nama config.ini yang lokasinya sama dengan lokasi executable.

[server]
#mode capture
#0:no save
#1:save to clipboard
#2:save to file (jpeg)
mode=2
datadir=data
jpegquality=40
fps=10

konfigurasi di atas akan membuat program webcam menyimpan 10 gambar tiap detik dengan kualitas kompresi sekitar 40 (untuk resolusi webcam 320×240 membutuhkan sekitar 5KB). Dari hasil hitung-hitungan. kalau 1 detik 10 gambar dikali 5 KB jadi 50. satu jam perlu 180MB. satu hari perlu 4GB. sedangkan 1 tahun perlu ~1.5TB. angka-angka tersebut adalah gambaran kasar dengan asumsi tiap detik direkam (biarpun tidak ada perubahan). untuk analisis lebih lanjut (membuat gambar-gambar yang tidak berubah) bisa dilakukan dengan membuat program lain yang bekerja pada direktori tersebut ^_^.

Web Interface

Berikutnya adalah program nomor 3 yaitu halaman web yang terdiri dari dua file yaitu index.html dan getimg.php.

<html>
	<head>
		<meta http-equiv="refresh" content="3" />
	</head>
	<body>
	<img src="getimg.php"/></body>
</html>

<?php
//file: getimg.php
$t = time().'.txt';
$result = system('cctv "C:\Program Files\Borland\Delphi7\Projects\cctv\data" > '.$t);
if (file_exists($t)){
	$result = file_get_contents($t);
	$img = urldecode(str_replace('%0D%0A', '', urlencode($result)));
	header('Content-type:image');
	echo file_get_contents($img);
	unlink($t);
}
?>

Perantara

Yang terakhir adalah program perantara. Ada alasan khusus mengapa saya membuat program perantara dibanding menjadikannya langsung dalam skrip PHP yaitu yang pertama terpikir. hehehe.. persoalannya adalah mengambil file terakhir (timestamp terbesar) dalam direktori yang membutuhkan iterasi ke tiap file (silakan coba buat versi skrip php-nya dan bandingkan dengan versi pemanggilan command-line).

program cctv;
{$APPTYPE CONSOLE}

uses
  SysUtils;

var
	tdir : string;

procedure pandu;
begin
  writeln( 'ERR: use cctv <datadir>' );
end;

function getlastfile( dir: string ): string;
var
  sr                : TSearchRec;
  FileAttrs         : integer;
  tmp               : string;
  mask              : string;
  cur, last         : longint;
begin
  result := '';
  last := -1;
  mask := '*.*';
  FileAttrs := faAnyFile or faDirectory;
  if FindFirst( dir + '\' + mask, FileAttrs, sr ) = 0 then begin
    repeat
      if ( Pos( '.', sr.Name ) <> 1 ) then begin
        tmp := dir + '\' + sr.Name;
        trystrtoint( changefileext( sr.Name, '' ), cur );
        if cur > last then begin
          result := tmp;
          last := cur;
        end;
      end;
    until FindNext( sr ) <> 0;
    FindClose( sr );
  end;
end;

begin
  if ParamCount < 1 then pandu;
  tdir := getlastfile( paramstr( 1 ) );
  if tdir <> '' then writeln( tdir );
end.

Penutup
Akhirnya selesai juga. pesan terakhir dari saya, tidak ada skinsyut hasil program karena subjek yang dijadikan skrinsyutnya (saya) sudah kusut . silakan dicoba sendiri, kalau ada yang nggak berhasil silakan komentar di sini (belum tentu saya bantu juga sih ).

Fungsi logaritma merupakan fungsi yang termasuk lambat, bahkan dibanding dengan trigonometri (CMIIW). Beberapa waktu yang lalu yang terjebak dalam persoalan yang seringkali memanggil fungsi logaritma khususnya log10 untuk setiap iterasi. walaupun sudah mengurangi pemanggilan dengan memanfaatkan variabel, namun tetap saja program berjalan lambat. Akhirnya setelah bertanya dan mencari-cari, ada[1] yang membuat implementasi fungsi logaritma yang lebih cepat dan tetap dalam batas error yang bisa diterima (1e-6). Idenya adalah membuat look-up table dari bit mantissa yang sudah dikuantisasi (di kliping) sehingga ukuran LUT-nya cukup kecil (implementasi yang saya buat hanya berukuran 256K) yang menurut penulis aslinya cukup untuk disimpan di dalam cache CPU.

Dari contoh kode yang dilampirkan di paper[1] dalam bahasa C dan untuk fungsi logaritma natural (ln), saya ubah sesuai dengan kebutuhan saya yaitu log10 dan dalam bahasa pascal (delphi)

var
 {16 bit used for mantissa lookup}
  lut               : array[0..65535] of single;
{IEEE 754 32-bit Floating-Point Number}

procedure precalc_lut;
var
  step              : integer;
  i, p, x           : integer;
  fval              : single;
  pf                : ^dword;

begin
  pf := @fval;
  x := $3F800000;
  pf^ := x;
  step := 1 shl 16;//23 - 7
  p := 1 shl 7;
  for i := 0 to p - 1 do begin
    lut[i] := log2( fval );
    x := x + step;
    pf^ := x;
  end;
end;

function _log10( val: single ): single; register;
var
  pf                : ^dword;
  x, log_2        : integer;
begin
  pf := @val;
  x := pf^;
  log_2 := ( ( x shr 23 ) and $FF ) - 127;
  x := (x and $7FFFFF) shr 16;
  result := (
  ( lut[x]
  + log_2
  )
  * 0.301029995664
  );
end;

hasilnya setelah diuji coba (1000000 pemanggilan fungsi, menggunakan gettickcount), lumayan ~4 kali lebih cepat dibanding fungsi log10 bawaan delphi (unit Math).

di lain pihak, ternyata Om Kiki pun membuat implementasi menggunakan deret MacLaurin dalam SSE. Walaupun nggak terlalu akurat dan terbatas di interval 0 < x < 2.

#include <cstdio>
#include <cmath>
#include <xmmintrin.h>

float maclaurin(float val){
        __declspec(align(16) ) float tmp[4] = { 1.0F,1.0F,1.0F,0.0F};
        __declspec(align(16) ) float multiplier[4] = { 1.0F,-0.5F,0.33333333F,-0.25F};
        tmp[3] = val;
        __m128 vec1 = _mm_load_ps(tmp);
        __m128 vec2 = _mm_shuffle_ps( vec1,vec1,0xF4);
        __m128 vec3 = _mm_shuffle_ps( vec1,vec1,0xFC);
        __m128 vec4 = _mm_shuffle_ps( vec1,vec1,0xFF);
        __m128 acc  = _mm_mul_ps(vec1, vec2);
        acc  = _mm_mul_ps(acc, vec3);
        vec1 = _mm_load_ps(multiplier);
        acc  = _mm_mul_ps(acc, vec4);
        acc  = _mm_mul_ps(acc,vec1);
        vec1 = _mm_shuffle_ps(acc,acc, 0xE4);
        vec2 = _mm_shuffle_ps(acc,acc, 0x39);
        vec3 = _mm_shuffle_ps(acc,acc, 0x4E);
        vec4 = _mm_shuffle_ps(acc,acc, 0x93);
        acc  = _mm_add_ps(vec1,vec2);
        acc  = _mm_add_ps( acc, vec3);
        acc  = _mm_add_ps(acc, vec4);
        float res;
        _mm_store_ss(&res,acc);
        return res;
}

float my_log(float x){
        return maclaurin(x - 1);
}

int main(){
        float reference = logf(1.3F);
        float target    = my_log(1.3F);
        printf(" reference = %g , target = %g\n", reference, target);
}

Referensi

1. vinyals, Oriol; et al. Revisiting Basic function on current CPUs: A fast logarithm implementation with adjustable accuracy. June 21, 2007. ICSI Berkeley Report

K-Means adalah teknik yang cukup sederhana dan cepat dalam pekerjaan pengelompokkan data (clustering). Prinsip utama dari teknik ini adalah menyusun k buah prototipe/pusat massa (centroid)/rata-rata (mean) dari sekumpulan data berdimensi n. Teknik ini mensyaratkan nilai k sudah diketahui sebelumnya (a priori). Algoritma k-means dimulai dengan pembentukan prototipe cluster di awal kemudian secara iteratif prototipe cluster ini diperbaiki hingga konvergen (tidak terjadi perubahan yang signifikan pada prototipe cluster). Perubahan ini diukur menggunakan fungsi objektif J yang umumnya didefinisikan sebagai jumlah atau rata-rata jarak tiap item data dengan pusat massa kelompoknya. Secara lebih detil algoritma k-means adalah seperti berikut :

1. inisialisasi nilai J (misal MAXINT)
2. Tentukan prototipe cluster awal (bisa secara acak ataupun dipilih salah satu secara acak dari koleksi data)
3. Masukkan tiap satuan data ke dalam kelompok yang jarak dengan pusat massa-nya paling dekat
4. ubah nilai pusat massa tiap cluster sebagai rata-rata (mean) dari seluruh anggota kelompok tersebut
5. Hitung fungsi objektif J
6. jika nilai J sama dengan sebelumnya, berhenti atau ulangi langkah 3

Berikut ini adalah contoh implementasi algoritma k-means dalam delphi.

{ garis besar kode }
type
  TTrainingData=record
    feature : array of real;
    truth : integer;
  end;

procedure DoKMeans;
begin
  Initialize;
  repeat
    Inc(NumStep);

    ReviseMinimum;
    CalculateCentroid;
    MeasureAccuracy;

  until IsConverge or (NumStep > MaxStep);
end;

var
  NumStep,MaxStep : longint;
  CurJ, OldJ : double;
  Err, MinErr : double;
  NumCorrect : integer;

  proposal : array of array of integer;
  centroid : array of array of double;
  distance : array of array of double;
  solution : array of integer;

  procedure RandomPick;
  var
    p, q, r : integer;
  begin
    for p := 0 to NumClass-1 do begin
      if p = 0 then
        r := Random(Length(FData))
      else
        r := r + Random((Length(FData)-r));

      for q := 0 to FeatureLength-1 do
        centroid[p][q] := FData[r].feature[q];
    end;
  end;

  procedure CalculateDistanceFromCentroids;
  var
    i, j, k : integer;
    tmp : double;
  begin
    for j := 0 to High(FData) do
      for i := 0 to NumClass-1 do begin
        tmp := 0.0;
        for k := 0 to FeatureLength-1 do
          tmp := tmp + sqr(FData[j].feature[k]-centroid[i][k]);
        distance[j][i] := sqrt(tmp);
      end;
  end;

  procedure Initialize;
  var
    p : integer;
  begin
    NumStep := 0;
    MaxStep := 3000;
    MinErr  := MAXINT;
    OldJ    := MAXINT;

    setlength(proposal, NumClass);
    setlength(centroid, NumClass);
    for p := 0 to NumClass-1 do begin
      setlength(proposal[p], 0);
      setlength(centroid[p], FeatureLength);
    end;

    setlength(solution, Length(FData));
    setlength(distance, Length(FData));
    for p := 0 to high(FData) do
      Setlength(distance[p], NumClass);

    RandomPick;
    CalculateDistanceFromCentroids;
  end;

  procedure CalculateCentroid;
  var
    i, j, k : integer;
    NumInstances : integer;
  begin
    for j := 0 to NumClass-1 do begin
      NumInstances := 0;
      for k := 0 to FeatureLength-1 do
          centroid[j][k] := 0.0;

      for i := 0 to High(proposal[j]) do begin
        for k := 0 to FeatureLength-1 do
          centroid[j][k] := centroid[j][k] + FData[proposal[j][i]].feature[k];
        Inc(NumInstances);
      end;

      if NumInstances > 0 then
        for k := 0 to FeatureLength-1 do
          centroid[j][k] := centroid[j][k] / NumInstances;
    end;
    CalculateDistanceFromCentroids;
  end;

  function IsConverge:boolean;
  var
    i, j : integer;
  begin
    CurJ := 0;
    for i := 0 to NumClass-1 do
      for j := 0 to High(proposal[i]) do
        CurJ := CurJ + distance[proposal[i][j]][i];

    Result := (Abs(CurJ-OldJ) < 1e-2);
    OldJ := CurJ;
  end;

  procedure ReviseMinimum;
  var
    i, j, p, minidx : integer;
    min : double;
  begin
    for p := 0 to NumClass-1 do
      setlength(proposal[p], 0);

    for j := 0 to High(FData) do begin
      minidx := 0;
      min := distance[j][minidx];
      for i := 1 to NumClass-1 do
        if distance[j][i] < min then begin
          minidx := i;
          min := distance[j][minidx];
        end;
      setlength(proposal[minidx], length(proposal[minidx])+1);
      proposal[minidx][high(proposal[minidx])] := j;
    end;
  end;

  procedure MeasureAccuracy;
  var
    i, j : integer;
    parsolution : array of integer;
  begin
    NumCorrect := 0;
    setlength(parsolution, Length(FData));
    for i := 0 to NumClass-1 do
      for j := 0 to High(proposal[i]) do
        parsolution[proposal[i][j]] := i+1;

    for i := 0 to High(FData) do
      if (parsolution[i] = FData[i].truth) then
        Inc(NumCorrect);

    Err := (Length(FData)-NumCorrect) * 100 / Length(FData);
    if Err < MinErr then begin
      MinErr := Err;
      for j := 0 to High(FData) do
        solution[j] := parsolution[j];
    end;
    Setlength(parsolution, 0);
  end;

Aplikasi
Algoritma nggak seru kalau tidak ada aplikasinya, jadi saya tampilkan skrinsyut aplikasi algoritma k-means untuk kuantisasi warna citra.

citra asal

citra hasil

Penutup
Algoritma k-means clustering walaupun cepat tetapi keakuratannya tidak dijamin. Seringkali algoritma ini mengalami konvergensi prematur. Pada algoritma di atas juga tidak dijamin jarak antara masing-masing centroid tidak merentang sehingga jika ada dua atau lebih kelompok dengan titik pusat massa yang berdekatan atau terdapat kelompok yang tidak memiliki anggota maka hasilnya akan tidak memuaskan.

Lagi iseng di sela-sela kerjaan, malah bikin implementasi fake glow. Mari bahas triknya tahap demi tahap!

citra awal

1. citra asal dikonversi ke greyscale



2. setengah intensitas bagian atas dipetakan ke intensitas maksimum



3. lakukan pengaburan/penghalusan supaya intensitas maksimum menyebar ke sekitarnya. salah satu cara yang sedikit ekstrim :
   • kecilkan ukuran citra hasil langkah sebelumnya menjadi 1/S kali (misal S = 8).
   • lakukan smoothing/perata-rataan dengan filter blur biasa (box kernel)
   • kembalikan ke ukuran semula (besarkan ukuran menjadi S kali)



4. Gabung citra asal dengan citra hasil tahap selanjutnya (citra 3). jika citra asal dalam ranah RGB (warna) maka tiap komponen ditambah dengan intensitas citra yang dikalikan dengan faktor skala tertentu (0.0 … 1.0)

Ini adalah proyek pribadi saya beberapa tahun yang lalu (sekitar tahun 2006) yang (tadinya) disiapkan untuk membantu tugas akhir duwita (yang sekarang menjadi istri saya) di program studi biologi itb. Comet assay merupakan salah satu teknik uji yang dilakukan untuk mengetahui dan memprediksi kerusakan substansi genetik (DNA) baik kualitatif maupun kuantitatif (CMIIW, karena saya bukan mahasiswa biologi ). Dinamakan komet karena objek yang terbentuk pada citra menyerupai bentuk komet (memiliki bagian kepala dan ekor). Topik tugas akhir istri saya waktu itu adalah pada sel sperma mencit yang didedah (exposed) dengan kadmium (Cd) yang diketahui terdapat pada rokok. Kerusakan ditunjukkan dengan terbentuknya ekor komet (DNA yang sehat akan berbentuk seperti halo karena rantai DNA-nya masih terhubung). Ekor komet muncul karena potongan DNA yang mengalami kerusakan struktur (single/double strand break) bergerak melalui pori-pori agarose akibat stimulus proses elektroforesis. Justifikasi visual dari gambar komet yang terbentuk adalah semakin banyak daerah ekor komet dan semakin kecil ukuran kepala komet dibanding luas area ekor maka kerusakan DNA yang terjadi semakin parah. Adapun ukuran analisis yang dipakai untuk memodelkan kerusakan secara kuantitatif ada bermacam-macam diantaranya panjang ekor (tail length) dan tail moment.

Hal yang menarik perhatian saya waktu itu adalah bahwa pekerjaan yang dilakukan adalah pengolahan dan interpretasi citra. Adapun aplikasi lain yang sudah tersedia baik komersial (COMET) ataupun Open-source(CASP). Aplikasi yang saya buat pun berbasis pada CASP namun saya terpaksa membuat ulang dengan delphi karena saya kesulitan dengan menggunakan library GUI pada CASP (kalau tidak salah menggunakan FOX) dan ada beberapa fitur yang ingin saya tambahkan seperti segmentasi otomatis pada beberapa citra sekaligus dan analisis otomatis terhadap sekumpulan RoI (region of interest) komet yang sudah disegmentasi dan diverifikasi.

Gambar 1 Contoh citra dari CASP

Pada awalnya cukup mudah untuk melakukan segmentasi kalau menggunakan contoh citra dari CASP (ditampilkan di gambar 1). Namun pada kenyataannya, hasil citra yang didapat tidak terlalu menggembirakan (Gambar 2). Penyebabnya ada banyak hal, diantaranya proses pencitraan (imaging) yang sangat tidak sempurna (menggunakan kamera film yang kemudian didigitalisasi menjadi citra digital), komposisi larutan uji yang kurang tepat sehingga distribusi objek komet menjadi rapat dan terdapat objek noise), dll. Pada awalnya saya sudah menyiapkan untuk fungsi akuisisi langsung (dengan memanfaatkan kamera cctv bawaan mikroskop fluoresens yang terhubung ke tv tuner sehingga bisa diakses menggunakan DirectShow) namun pengadaan tv tuner USB tidak bisa terlaksana dan saya tidak bisa sembarangan mengakses mikroskop karena bertentangan dengan kebijakan biologi (karena saya tidak secara resmi berkepentingan menggunakan perangkat yang aksesnya bagi civitas biologi pun terbatas pada tugas akhir dan penelitian). Sempat juga mengajukan proposal penelitian untuk mempelajari proses terbentuknya komet sehingga prediksi kerusakan bisa lebih akurat sebagai pelengkap dari aplikasi yang saya kembangkan namun sayang proposal tersebut tidak disetujui.

Gambar 2 citra komet hasil pengerjaan

Aplikasinya pun berevolusi karena digunakan juga untuk kepentingan lain (penelitian Document Image Recognition, dan penelitian untuk DMR) sehingga saya tidak bisa mempublikasikan aplikasi yang sudah saya buat.

Pengalaman pertama saya menggunakan CLIPS _[1] adalah ketika saya mengambil mata kuliah sistem berbasis pengetahuan sewaktu S1. Waktu itu saya membuat tugas besar dengan topik sistem untuk penyusun playlist lagu otomatis (sistem pakar music director radio siaran atau ESMooD ~ Expert System for Music Director) yang pakarnya merupakan teman-teman kru di Radio Kampus ITB yang memang pekerjaan hariannya menyusun playlist lagu untuk keperluan siaran.

CLIPS yang saya ketahui waktu itu antarmuka dengan penggunanya kalau tidak berbasis console (CLIPS.exe) atau WebCLIPS sedangkan aplikasi sistem pakar yang ingin saya buat adalah program berbasis desktop GUI supaya bisa langsung digunakan (:D). Akhirnya saya menemukan komponen VCL yang membungkus CLIPS.dll sehingga bisa digunakan dalam lingkungan Delphi (:victory:). Karena keterbatasan waktu pengerjaan tugas dan pengetahuan waktu itu, programnya pun dibuat ala kadarnya saja. Mekanisme yang digunakan di dalamnya hanya melakukan load basis kaidah, fakta awal yang merupakan preference dari seorang music director (MD) dan daftar lagu yang dianggarkan untuk minggu tertentu, lalu menjalankan mesin inferensi tanpa proses interaksi dan hasil playlist didapat dari melakukan dump working memory.

Beberapa waktu (lebih tepatnya bulan) yang lalu saya mengembangkan aplikasi Desktop GUI sebagai perantara antarmuka untuk CLIPS menggunakan delphi. Aplikasi ini cara kerjanya mirip dengen WEBCLIPS hanya saja untuk mengaksesnya langsung pada desktop. Fasilitas yang sudah tercapai antara lain MessageBox ,Status Message, dan Multi text untuk menampilkan teks, Radio Group, Checkbox, dan InputBox untuk mendapatkan masukan, Fasilitas untuk menyimpan dan membuka session, serta menampilkan daftar fakta dalam bentuk pohon. Kode dan binary sudah saya simpan di Google tapi dokumentasinya belum ada dan contoh aplikasinya juga (sebetulnya sudah ada aplikasi yang menggunakan pebclips, namun aplikasi itu milik orang lain dan mungkin diniatkan menjadi produk komersil sehingga tidak bisa disertakan). Semoga saja aplikasi ini bisa bermanfaat dan bisa terus dikembangkan.

tampilan pebclips

Setelah beberapa tulisan^[1][2] mengenai OpenMP sebagai bahan kuliah saya jadi penasaran untuk membuat tiruannya dengan Delphi berhubung Delphi (saya pakai versi 7) memiliki kelas wrapper untuk menggunakan fasilitas threading di Win32. Sebetulnya Delphi versi 7 sudah lumayan tertinggal (mengingat sekarang sudah ada Delphi 200X) dalam hal pengembangan (tapi belum tahu juga untuk versi Turbo Delphi) dan untuk varian lainnya adalah FreePascal tetapi alternatif yang diajukan di FreePascal sepertinya tidak kompatibel secara bahasa dengan versi Object Pascal yang digunakan di Delphi 7 jadinya saya masih ragu-ragu. Akhirnya saya teruskan niat untuk mencoba membuat implementasi dari secuil fitur paralelisme OpenMP yaitu parallel for (untuk modifikasi sekumpulan data yang independen).

Pendahuluan

Langkah pertama adalah membuat algoritma sekuensial yang ingin diparalelkan (dibuat menjadi algoritma yang berjalan secara paralel). Algoritma yang saya pilih adalah seperti tulisan ini yaitu operasi terhadap seluruh elemen array 2 dimensi (misalnya citra) yang hanya melibatkan masing-masing elemen tersebut. Kodenya kira-kira seperti ini (yang dicetak miring adalah operasi elementernya)

for j := 0 to high(arr) do
    for i := 0 to high(arr[j]) do begin
      arr[j][i] := arr[j][i] + 10; { operasi elementer }
    end;

Algoritma ini dipilih karena dianggap cukup sederhana karena jika diimplementasi secara paralel menggunakan thread maka antar thread tidak perlu melakukan komunikasi. Algoritma di atas cukup (bahkan mungkin terlalu) sederhana sehingga tidak bisa dibandingkan dengan algoritma paralel karena untuk membuat algoritma versi paralel ada overhead untuk penciptaan thread, penjadwalan, delegasi tugas, dan pembersihan. Oleh sebab itu yang dijadikan acuan untuk melakukan perbandingan performa adalah algoritma versi paralel yang hanya dikerjakan oleh satu buah thread saja. Waktu eksekusi untuk satu thread ini selanjutnya disebut sebagai t₁ sedangkan waktu eksekusi algoritma versi paralel dengan n buah thread akan disebut sebagai t_n sehingga pemercepatan (peningkatan kecepatan) akan dihitung sebagai perbandingan antara t₁ dengan t_n (t₁/t_n).

Pembuatan kelas Worker Thread

Penggunaan fasilitas threading di Delphi ada dua macam cara. Cara pertama adalah memanfaatkan fungsi-fungsi yang berkaitan dengan thread pada Win32 API dan cara kedua adalah membuat kelas turunan dari kelas TThread. Cara kedua dipilih secara subjektif dengan alasan kenyamanan pengelolaan. Pembuatan kelas turunan TThread dapat memanfaatkan wizard dari delphi dengan menggunakan menu File>New>Other>Thread Object. Fungsi yang ingin dijalankan pada thread ditempatkan sebagai fungsi execute yang menutup(override) implementasi dari kelas TThread. Sifat dari penggunaan kelas turunan TThread adalah objek tersebut akan dibebaskan dari memori setelah fungsi execute selesai dijalankan. Penciptaan dan Pembebasan ini tentunya akan menyebabkan redundansi proses yang tidak terlalu relevan dengan tujuan awal (mempercepat eksekusi). Oleh sebab itu perlu dibuat cara lain sedemikian rupa sehingga objek thread hanya perlu diciptakan sekali sebelum proses utama dilakukan dan hanya perlu sekali dibebaskan dari memori setelah seluruh pekerjaan selesai. Caranya adalah dengan membuat atribut status pada kelas thread dan membuat isi fungsi execute ini melakukan perulangan hingga tercapai status akhir (final state). Untuk itu kita perlu tiga buah keadaan yaitu Running, Idle, dan Done. Pada awalnya keadaan akan diinisialisasi sebagai Idle. Keadaan ini adalah keadaan yang menyatakan objek thread tidak sedang sibuk melakukan pekerjaan sehingga dapat didelegasikan. Jika objek thread sedang sibuk maka keadaannya adalah Running. Kode untuk kelas thread ditunjukkan dalam kode berikut :

unit Unit2;

interface

uses
  Classes, Windows, SysUtils;

type
  TThreadState = (tsRunning, tsIdle, tsDone);
  TArrElmtModifier = class(TThread)
  private
    { Private declarations }
    FX, FY, FID: integer;
    FState : TThreadState;
  protected
    procedure Execute; override;

    procedure NotifyStart;
    procedure NotifyDone;
  public
    constructor Create(AID:integer);
    procedure Run;
    procedure Done;
    property X : integer read FX write FX;
    property Y : integer read FY write FY;
    property ID : integer read FID write FID;
    property State : TThreadState read FState write FState;
  end;

implementation

uses Unit1;

{ TArrElmtModifier }

constructor TArrElmtModifier.Create(AID:integer);
begin
  inherited Create(false);
  FID := AID;
  X := 0;
  Y := 0;
  State := tsIdle;
  self.FreeOnTerminate := false;
end;

procedure TArrElmtModifier.Done;
begin
  FState := tsDone;
end;

procedure TArrElmtModifier.Execute;
begin
  { Place thread code here }
  while (FState<>tsDone) do begin
    if (FState=tsRunning) then begin
      { Do Thread Task here }
      Form1.arr[Y][X] := Form1.arr[Y][X] + 10;
      NotifyDone;
      { Notify when task done }
    end;
    sleep(1);
  end;
end;

procedure TArrElmtModifier.NotifyDone;
begin
  Form1.AcceptDone(FID);
  State := tsIdle;
end;

procedure TArrElmtModifier.NotifyStart;
begin
  Form1.Memo1.Lines.Add('Thread #'+inttostr(FID)+' started');
end;

procedure TArrElmtModifier.Run;
begin
  State := tsRunning;
end;

end.

Implementasi Parallel for

Langkah selanjutnya adalah melakukan penjadwalan untuk alokasi pekerjaan dalam iterasi for agar dikerjakan oleh worker thread. Penyederhanaan (tanpa menggunakan antrian pekerjaan) dilakukan dengan penurunan tiap pekerjaan langsung diturunkan dari pola perulangan yang sama seperti pada algoritma sekuensial sehingga urutan pekerjaan menjadi terurut sesuai dengan eksekusi for. Selanjutnya dilakukan penjadwalan delegasi thread agar tiap thread mendapatkan proporsi beban pekerjaan yang cukup seimbang satu sama lain. Hal ini dilakukan dengan menggunakan antrian berbentuk cincin (ring queue) yang secara sederhana diimplementasi dengan memanfaatkan operator modulo pada struktur data kumpulan objek thread yang menggunakan array. Setelah semua pekerjaan didelegasikan perlu dibuat mekanisme barrier yang akan menunggu konfirmasi penyelesaian dari seluruh thread sebelum thread dibebaskan dari memori. Langkah terakhir adalah menampilkan perubahan. Hasil implementasi pada kode utama ditampilkan sebagai berikut :

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    SpinEdit1: TSpinEdit;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    SpinEdit2: TSpinEdit;
    Button1: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    nthreads : integer;
    threadflags : array of boolean;
    threads : array of TArrElmtModifier;
    arr : array of array of integer;
    tq : integer;
    procedure Prepare;
    procedure DispatchThreads;
    procedure AcceptDone(idx:integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AcceptDone(idx: integer);
begin
  threadflags[idx] := false;
  //memo1.lines.Add('done #'+inttostr(idx));
end;

procedure TForm1.DispatchThreads;
var
  i, j, k : integer;
  busy : boolean;
  tmp : tstrings;
  start, finish : longint;
begin
  Memo1.Lines.Clear;
  start := GetTickCount;

  { ordered scheduling }
  for j := 0 to high(arr) do
    for i := 0 to high(arr[j]) do begin
      { schedule iteration(i,j) }
      busy := true;
      repeat
        k := tq; //GetNextAvailableThread
        //if not threadflags[k] then begin
        if threads[k].State = tsIdle then begin
          threadflags[k] := true;
          //memo1.lines.add(format('dispatch (%d,%d) to thread #%d', [i,j,k]));
          threads[k].X := i;
          threads[k].Y := j;
          threads[k].Run;
          busy := false;
          break;
        end;
        tq := (tq + 1) mod length(threads);
        Application.ProcessMessages;
      until not busy;
    end;

  { barrier, wait until all task finished }
  repeat
    busy := false;
    for k := 0 to high(threads) do begin
      if threadflags[k] then begin
        busy := true;
        break;
      end;
    end;
    Application.ProcessMessages;
  until not busy;
  finish := GetTickCount;
  { clean up threads }
  for i := 0 to high(threads) do
    threads[i].State := tsDone;

  { display changes }
  tmp := TStringlist.Create;
  for j := 0 to high(arr) do begin
    tmp.Clear;
    for i := 0 to high(arr[j]) do begin
      tmp.add(inttostr(arr[j][i]));
    end;
    memo1.Lines.add(tmp.CommaText);
  end;
  Memo1.Lines.Add('Done in '+inttostr(finish-start)+' ms');
  tmp.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i : integer;
begin
  Prepare;

  nthreads := SpinEdit1.Value;
  setlength(threadflags, nthreads);
  setlength(threads, nthreads);
  for i := 0 to high(threads) do begin
    threadflags[i] := false;
    threads[i] := TArrElmtModifier.Create(i);
  end;

  DispatchThreads;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i, j, k : integer;
  start, finish : cardinal;
  tmp : TStrings;
begin
  Prepare;
  Memo1.Lines.Clear;
  start := GetTickCount;

  { ordered scheduling }
  for j := 0 to high(arr) do
    for i := 0 to high(arr[j]) do begin
      arr[j][i] := arr[j][i] + 10;
    end;

  finish := GetTickCount;

  { display changes }
  tmp := TStringlist.Create;
  for j := 0 to high(arr) do begin
    tmp.Clear;
    for i := 0 to high(arr[j]) do begin
      tmp.add(inttostr(arr[j][i]));
    end;
    memo1.Lines.add(tmp.CommaText);
  end;
  Memo1.Lines.Add('Done in '+inttostr(finish-start)+' ms');
  tmp.Free;
end;

procedure TForm1.Prepare;
var
  i,n : integer;
begin
  n := SpinEdit2.Value;

  if length(arr)>0 then
    for i := 0 to high(arr) do
      setlength(arr[i], 0);

  setlength(arr, n);
  for i := 0 to high(arr) do
    setlength(arr[i], n);
  tq := 0;
end;

end.

Tampilan Form (4K PNG)

Pengujian

Untuk menguji perubahan kecepatan pada penggunaan thread digunakan dimensi array 10×10 dan jumlah thread yang diuji antara lain 1 (kontrol), 2, 4, 8, 16 (diabaikan karena asimtotik). Hasil pengukuran ditunjukkan pada gambar berikut.

Grafik Speedup (4K PNG)

Penutup

Sepertinya bisa dinyatakan berhasil, walaupun sebelumnya saya coba justru bisa dibilang gagal karena penggunaan multithread justru memperlambat (mungkin karena saya menjalankan langsung dari IDE). Selanjutnya mungkin saya akan mencoba bagaimana mengimplementasi pola eksekusi berbentuk pohon, analisis statik independensi antar operasi, dan komunikasi (sinkronisasi) antar thread yang pada tujuan akhirnya adalah mewujudkan salah satu mimpi saya terdahulu yaitu membuat bahasa pemrograman (next generation programming language) paralel (akhirnya tujuan perancangannya bisa lebih spesifik) yang memanfaatkan threading secara implisit (tidak perlu menyatakan pembuatan dan pembersihan objek thread secara eksplisit dalam kode program) dan sebisa mungkin makin meng-eksplisitkan independensi antar data/task pada kode program dan penulisan yang bersih dan nyaman untuk dibaca (yang terakhir agak subjektif dan kurang terdefinisi, hehehe). Perwujudan ini (mungkin) dilakukan dalam beberapa tahap yaitu pengembangan abstract machine (sebagai testbed komputer paralel), interpreter, dan pada akhirnya implementasi compiler dan IDE untuk bahasa baru ini yang untuk sementara saya namakan sebagai ‘project pi’ (akhirnya ada juga namanya).