![]() |
Project Jaringan Syaraf Tiruan dengan menggunakan delphi 7 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeEngine, Series, Menus, ExtCtrls, TeeProcs, Chart, ComCtrls,
StdCtrls, ALBasicAudioOut, ALAudioOut, LPComponent, ALCommonPlayer,
ALWavePlayer, math, ImgList, acAlphaImageList, sSkinProvider,
sSkinManager, Buttons, sButton;
type
Twindow=(blackman,hanning,hamming,bartlett);
T1dimensi=array of double;
Tdatabobot=array of T1dimensi;
T3dimensi=array of Tdatabobot;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
ALWavePlayer1: TALWavePlayer;
ALAudioOut1: TALAudioOut;
RichEdit1: TRichEdit;
RichEdit2: TRichEdit;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
StatusBar1: TStatusBar;
Chart1: TChart;
File1: TMenuItem;
BukaFile1: TMenuItem;
AutoProcess1: TMenuItem;
Series1: TLineSeries;
sSkinManager1: TsSkinManager;
Exit1: TMenuItem;
Panel1: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Label8: TLabel;
Timer1: TTimer;
BitBtn4: TBitBtn;
componen1: TMenuItem;
Hapus1: TMenuItem;
SinyalSuara1: TMenuItem;
HeaderFile1: TMenuItem;
ProcessingSpeech1: TMenuItem;
FileSpeech1: TMenuItem;
otalSuara1: TMenuItem;
JumlahHiddenLayer1: TMenuItem;
HapusSemua1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
BitBtn5: TBitBtn;
Help2: TMenuItem;
Aboutme1: TMenuItem;
BitBtn6: TBitBtn;
SaveDialog1: TSaveDialog;
Exit2: TMenuItem;
rainingnProcess1: TMenuItem;
ALLDELETE1: TMenuItem;
Button1: TsButton;
Button2: TsButton;
Button3: TsButton;
Button4: TsButton;
procedure BukaFile1Click(Sender: TObject);
procedure AutoProcess1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure SinyalSuara1Click(Sender: TObject);
procedure HeaderFile1Click(Sender: TObject);
procedure ProcessingSpeech1Click(Sender: TObject);
procedure FileSpeech1Click(Sender: TObject);
procedure otalSuara1Click(Sender: TObject);
procedure JumlahHiddenLayer1Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure Aboutme1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure Exit2Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure HapusSemua1Click(Sender: TObject);
procedure rainingnProcess1Click(Sender: TObject);
procedure ALLDELETE1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
MATHPHI=3.1415926535897932384626433832795;
MAXDATA=15000;//15000 sample
UKURANFRAME=2048;
FREKUENSI=12000;//12 KHz sample rate
var
Form1: TForm1;
maksuji,jumlahuji :word;
PosisiFile :Byte;
JData :integer;
Iterasi :integer;
Alpha:double;
Miu:double;
ErorMax:double;
StrIdentitas:array of string;
HUnit:array of integer;
JumHidden:Byte;
HTemp:array of integer;
RealData:array of double;
PanData:Integer;
Masuk:Tdatabobot;
Cep:Tdatabobot;
IUnit:Integer;
wbobot:Tdatabobot;
vbobot:array of Tdatabobot;
implementation
uses Unit2, Unit3, Unit4, Fourier;
{$R *.dfm}
procedure BukaFileData(const namafile:string);
var
F:File of Smallint;
dumdata:Smallint;
loop:word;
begin
AssignFile(F,namafile);
Reset(F);
Seek(F,0);
SetLength(RealData,MAXDATA);
for loop:=0 to MAXDATA-1 do
begin
Read(F,dumdata);
RealData[loop]:=dumdata;
end;
CloseFile(F);
end;
//--------------------------------
procedure LaporkanKeMemo(const namafile:string);
begin
with Form1, Memo1.Lines do
begin
Clear;
Add('Buka File : '+namafile);
Add('File speech dengan header File :');
Add('- RIFF chunck');
Add('- Mode Mono');
Add('- 12 KHZ sample rate');
Add('- 16 bit signed data');
Add('- 15000 sample data = 1.25 s');
end;
end;
//-------------------------------
procedure GraphikkanKeWave;
var
loop:word;
begin
with Form1, Series1 do
begin
Clear;
for loop:=0 to MAXDATA-1 do
Add(RealData[loop]);
end;
end;
//--------------------------------------
Procedure TampilkanProsess(proses:Byte);
var
loop1:Byte;
loop2:Byte;
begin
with Form1, RichEdit2.Lines do
begin
case proses of
0:begin
Clear;
Add('PreProcessing :');
end;
1:Add('Baca Data Sinyal Speech ...');
2:Add('Framing Data ...');
3:Add('PreEmphasis ...');
4:Add('Windowing ...');
5:Add('FFT ...');
6:Add('LPC ...');
7:Add('Cepstral ...');
100:
begin
Add('SUKSESS ...');
Add('------------------------------');
Add('Jumlah Koefisien Cepstral :'+FloatToStr(high(Cep)+1));
Add('Jumlah Frame :'+FloatToStr(high(Cep[1])+1));
for loop1:=0 to high(Cep) do
begin
Add('==============================');
for loop2:=0 to high(Cep[loop1]) do
Add('Frame['+IntToStr(loop2)+']'+'Coef['+IntToStr(loop1)+']'+
#9+ FloatToStr(Cep[loop1,loop2]));
end;
end;
end;
end;
end;
//--------------------------------
//------------------------------------------
procedure PreProcessing(sinyal:array of double);
var
p:integer;
i:integer;
j:integer;
win:array of double;
aut:array of double;
realtime:Tdatabobot;
imgtime:Tdatabobot;
realfrek:Tdatabobot;
imgfrek:Tdatabobot;
jumframe:integer;
begin
TampilkanProsess(0);
TampilkanProsess(1);
jumframe:=FrameCount(UKURANFRAME,UKURANFRAME div 3,
high(sinyal)+1);
setlength(realtime,jumframe);
setlength(imgtime,jumframe);
setlength(realfrek,jumframe);
setlength(imgfrek,jumframe);
setlength(Cep,jumframe);
TampilkanProsess(2);
pre_emphasis(0.94,sinyal);
setlength(realtime,jumframe);
for i:=0 to jumframe-1 do
begin
setlength(realtime[i],UKURANFRAME);
setlength(imgtime[i],UKURANFRAME);
setlength(realfrek[i],UKURANFRAME);
setlength(imgfrek[i],UKURANFRAME);
end;
TampilkanProsess(3);
framing(UKURANFRAME,UKURANFRAME div 3,sinyal,realtime);
TampilkanProsess(4);
setlength(win,UKURANFRAME);
win_sinyal(0,hanning,win);
TampilkanProsess(5);
for i:=0 to jumframe-1 do
for j:=0 to UKURANFRAME-1 do
realtime[i,j]:=realtime[i,j]*win[j];
for i:=0 to jumframe-1 do
fft(UKURANFRAME,realtime[i],imgtime[i],realfrek[i],imgfrek[i]);
for i:=0 to jumframe-1 do
for j:=0 to UKURANFRAME-1 do
realfrek[i,j]:=sqrt(sqr(realfrek[i,j])+sqr(imgfrek[i,j]));
TampilkanProsess(6);
p:=MakeOrder(FREKUENSI);
setlength(aut,p+1);
for i:=0 to jumframe-1 do
begin
setlength(Cep[i],p+1);
LPCAnalisis(realfrek[i],UKURANFRAME,p,aut);
lpc2cepstral(p,p,aut,Cep[i]);
weightingcepstral(p,Cep[i]);
end;
TampilkanProsess(7);
TampilkanProsess(100);
end;
//---------------------------------
function InitTarget(var target:Tdatabobot):integer;
var
a:integer;
b:integer;
sisa:integer;
ounit:integer;
begin
setlength(target,jdata);
sisa:=jdata mod 3;
if sisa<>0 then
sisa:=1;
ounit:=jdata div 3 +sisa+1;
for a:=0 to jdata-1 do
begin
setlength(target[a],ounit);
for b:=1 to ounit-1 do
target[a,b]:=0.1;
target[a,1+ a div 3]:=0.3+ 0.3*(a mod 3);
end;
result:=ounit;
end;
//-----------------------------------------
function CekBobotAll(hiden_in,hiden:Tdatabobot;
out_in,output:t1dimensi;
target:Tdatabobot;jhiden:integer):boolean;
var
i:integer;
num:integer;
kenal:integer;
sum:double;
begin
result:=false;
kenal:=0;
for num:=0 to high(masuk) do
begin
//---------feedforrward proses---------//
LayerIn(masuk[num],hiden_in[0],vbobot[0]);
FungsiAktivasi(hiden_in[0],hiden[0]);
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
LayerIn(hiden[i],hiden_in[i+1],vbobot[i+1]);
FungsiAktivasi(hiden_in[i+1],hiden[i+1]);
end;
LayerIn(hiden[jhiden-1],out_in,wbobot);
FungsiAktivasi(out_in,output);
sum:=0;
for i:=1 to high(output) do
sum:=sum+abs(output[i]-target[num,i]);
sum:=sum/jdata;
if sum<ErorMax then
inc(kenal);
end;
if kenal=jdata then
result:=true;
end;
//--------------------------------------------
procedure InitTrain(var vbobotold:T3dimensi;var
wbobotold:Tdatabobot;
var hiden,hiden_in,eror_j:Tdatabobot;var
output,out_in,eror_k:T1dimensi;
ounit:integer);
var
i:integer;
j:integer;
jhiden:integer;
begin
setlength(hiden,length(hunit));
setlength(hiden_in,length(hunit));
setlength(eror_j,length(hunit));
for i:=0 to high(hunit) do
begin
setlength(hiden[i],hunit[i]);
setlength(hiden_in[i],hunit[i]);
setlength(eror_j[i],hunit[i]);
hiden[i,0]:=1;
end;
setlength(output,ounit);
setlength(out_in,ounit);
setlength(eror_k,ounit);
setlength(vbobot,length(hunit));
setlength(vbobotold,length(hunit));
setlength(vbobot[0],iunit);
setlength(vbobotold[0],iunit);
for i:=0 to iunit-1 do
begin
setlength(vbobot[0,i],hunit[0]);
setlength(vbobotold[0,i],hunit[0]);
end;
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
setlength(vbobot[i+1],hunit[i]);
setlength(vbobotold[i+1],hunit[i]);
for j:=0 to hunit[i]-1 do
begin
setlength(vbobot[i+1,j],hunit[i+1]);
setlength(vbobotold[i+1,j],hunit[i+1]);
end;
end;
jhiden:=length(hunit);
setlength(wbobot,hunit[jhiden-1]);
setlength(wbobotold,hunit[jhiden-1]);
for i:=0 to hunit[jhiden-1]-1 do
begin
setlength(wbobot[i],ounit);
setlength(wbobotold[i],ounit);
end;
InisialisasiBobot(vbobot,wbobot);
end;
//-----------------------------------------
function DoTrain:integer;
var
vbobotold:T3dimensi;
wbobotold:Tdatabobot;
output:T1dimensi;
out_in:T1dimensi;
eror_k:T1dimensi;
hiden:Tdatabobot;
hiden_in:Tdatabobot;
eror_j:Tdatabobot;
target:Tdatabobot;
loop:integer;
num:integer;
jhiden:integer;
i:integer;
j:integer;
kenal:integer;
ounit:integer;
sum:double;
sumall:double;
begin
jhiden:=length(hunit);
ounit:=InitTarget(target);
InitTrain(vbobotold,wbobotold,hiden,hiden_in,eror_j,
output,out_in,eror_k,ounit);
for loop:=1 to iterasi do
begin
kenal:=0;
sumall:=0;
application.ProcessMessages;
for num:=0 to high(masuk) do
begin
//---------feedforrward proses---------//
LayerIn(masuk[num],hiden_in[0],vbobot[0]);
FungsiAktivasi(hiden_in[0],hiden[0]);
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
LayerIn(hiden[i],hiden_in[i+1],vbobot[i+1]);
FungsiAktivasi(hiden_in[i+1],hiden[i+1]);
end;
LayerIn(hiden[jhiden-1],out_in,wbobot);
FungsiAktivasi(out_in,output);
//----------------cek target yg dicapai-----------
if loop mod 10=0 then
begin
sum:=0;
for i:=1 to high(output) do
sum:=sum+abs(output[i]-target[num,i]);
sum:=sum/jdata;
if sum<ErorMax then
inc(kenal);
sumall:=sumall+sum;
Form1.statusbar1.Panels[1].Text:=' Data identify'+inttostr(kenal)+ ' from '+inttostr(jdata)+ ' at'+inttostr(loop)+' epoch';
if num=high(masuk) then
Form1.statusbar1.Panels[2].Text:=' Error ='+floattostr(sumall/jdata);
if kenal=jdata then if CekBobotAll(hiden_in,hiden,out_in,output,target,jhiden) then
begin
result:=2;
exit;
end;
end;
//------backforward proses----------//
CalculateOutputEror(target[num],output,out_in,eror_k);
CalculateHidenEror(eror_k,hiden_in[jhiden-1],
wbobot,eror_j[jhiden-1]);
if high(hunit)>0 then
for i:=high(hunit) downto 1 do
CalculateHidenEror(eror_j[i],hiden_in[i-1],vbobot[i],
eror_j[i-1]);
//---------update bobot------------//
UpdateBobot(alpha,miu,eror_k,hiden[jhiden-1],wbobot,wbobotold);
UpdateBobot(alpha,miu,eror_j[0],masuk[num],vbobot[0],
vbobotold[0]);
if high(hunit)>0 then
for i:=high(hunit) downto 1 do
UpdateBobot(alpha,miu,eror_j[i],hiden[i-1],vbobot[i],
vbobotold[i]);
end;
end;
result:=1;//-------normal exit
end;
//----------------------------------
procedure InitRead(var hiden_in,hiden:Tdatabobot;
var out_in,output:T1dimensi;ounit:integer);
var
i:integer;
begin
setlength(hiden,length(hunit));
setlength(hiden_in,length(hunit));
for i:=0 to high(hunit) do
begin
setlength(hiden[i],hunit[i]);
setlength(hiden_in[i],hunit[i]);
hiden[i,0]:=1;
end;
setlength(output,ounit);
setlength(out_in,ounit);
end;
//---------------------------------
function
GetDecision(output:t1dimensi;target:Tdatabobot):integer ;
var
i:integer;
j:integer;
sum:double;
min_e:double;
begin
min_e:=1000;
result:=0;
for i:=0 to high(target) do
begin
sum:=0;
for j:=1 to high(target[i]) do
sum:=sum+abs(output[j]-target[i,j]);
if min_e>sum then
begin
result:=i;
min_e:=sum;
end;
end;
end;
procedure TForm1.BukaFile1Click(Sender: TObject);
begin
with OpenDialog1 do
begin
Title:='Buka File Data';
Filter:='data File (*.wav)|*.wav';
DefaultExt:='dat';
FileName:='';
InitialDir:=ExtractFileDir(ParamStr(0))+'\data';
if Execute then
begin
BukaFileData(FileName);
LaporkanKeMemo(FileName);
GraphikkanKeWave;
end;
end;
AutoProcess1.Enabled:=true;
end;
procedure TForm1.AutoProcess1Click(Sender: TObject);
begin
PreProcessing(RealData);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
jumlahuji:=0;
Button1.enabled:=true;
Button2.enabled:=false;
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
var
a:integer;
temp:string;
begin
JumHidden:=strtoint(ComboBox2.Text);
setlength(HTemp,JumHidden);
for a:=0 to JumHidden-1 do
begin
temp:='25';
inputquery('Jumlah Unit Hiden Ke -'+inttostr(a+1), 'Jumlah Unit :',temp);
HTemp[a]:=strtoint(temp);
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
with OpenDialog1 do
begin
Title:='Buka File Data';
Filter:='data File (*.wav)|*.wav';
DefaultExt:='dat';
FileName:='';
InitialDir:=ExtractFileDir(ParamStr(0))+'\data';
if Execute then
begin
BukaFileData(FileName);
LaporkanKeMemo(FileName);
GraphikkanKeWave;
end;
end;
AutoProcess1.Enabled:=true;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
close
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
PreProcessing(RealData);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
label8.Left := label8.Left - 5;
if label8.Left <= -100 then
label8.Left := 550;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
memo1.Clear;
richedit1.Clear;
richedit2.Clear;
combobox1.ClearSelection;
combobox2.ClearSelection;
Series1.Clear;
statusbar1.Panels[0].Text:='';
statusbar1.Panels[1].Text:='';
statusbar1.Panels[2].Text:='';
label7.Caption:='';
end;
procedure TForm1.SinyalSuara1Click(Sender: TObject);
begin
Series1.Clear;
end;
procedure TForm1.HeaderFile1Click(Sender: TObject);
begin
memo1.Clear;
end;
procedure TForm1.ProcessingSpeech1Click(Sender: TObject);
begin
richedit1.Clear;
end;
procedure TForm1.FileSpeech1Click(Sender: TObject);
begin
richedit2.Clear;
end;
procedure TForm1.otalSuara1Click(Sender: TObject);
begin
combobox1.ClearSelection;
end;
procedure TForm1.JumlahHiddenLayer1Click(Sender: TObject);
begin
combobox2.ClearSelection;
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
begin
MessageDlg ('Pengenalan Suara Menggunakan Jaringan Syaraf Tiruan' + #13 +
'JST adalah suatu teknologi komputasi yg berbasis pada model syaraf biologis dan mencoba mensimulasikan tingkah laku dan kerja model syaraf terhadap berbagai macam masukan ' + #13 +
'"Mastering Delphi 7" written by Muhammad Ichsan',
mtInformation, [mbOk], 0);
end;
procedure TForm1.Aboutme1Click(Sender: TObject);
begin
MessageDlg ('Pengenalan Suara Menggunakan Jaringan Syaraf Tiruan' + #13 +
'JST adalah suatu teknologi komputasi yg berbasis pada model syaraf biologis dan mencoba mensimulasikan tingkah laku dan kerja model syaraf terhadap berbagai macam masukan ' + #13 +
'"Mastering Delphi 7" written by Muhammad Ichsan',
mtInformation, [mbOk], 0);
end;
procedure TForm1.About1Click(Sender: TObject);
begin
Panel1.Visible := not Panel1.Visible;
About1.Checked := Panel1.Visible;
end;
procedure TForm1.BitBtn6Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
richedit2.Lines.SaveToFile (SaveDialog1.FileName);
end;
end;
procedure TForm1.Exit2Click(Sender: TObject);
begin
close ;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
Memo1.Lines.SaveToFile (SaveDialog1.FileName);
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if MessageDlg('Apakah anda yakin untuk'+#13+'keluar dari program ini ?',
mtConfirmation,[mbYes,mbNo],0)=mrNo then
CanClose:=False;
end;
procedure TForm1.HapusSemua1Click(Sender: TObject);
begin
label7.Caption:='';
end;
procedure TForm1.rainingnProcess1Click(Sender: TObject);
begin
statusbar1.Panels[0].Text:='';
statusbar1.Panels[1].Text:='';
statusbar1.Panels[2].Text:='';
end;
procedure TForm1.ALLDELETE1Click(Sender: TObject);
begin
memo1.Clear;
richedit1.Clear;
richedit2.Clear;
combobox1.ClearSelection;
combobox2.ClearSelection;
Series1.Clear;
statusbar1.Panels[0].Text:='';
statusbar1.Panels[1].Text:='';
statusbar1.Panels[2].Text:='';
label7.Caption:='';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
maksuji:=strtoint(ComboBox1.text);
with OpenDialog1 do
begin
Title:='Buka File Data';
Filter:='data File (*.wav)|*.wav';
DefaultExt:='wav';
FileName:='';
InitialDir:=ExtractFileDir(ParamStr(0))+'\data';
if Execute then
begin
inc(PosisiFile);
RichEdit1.Lines.Add(FileName);
end;
end;
jumlahuji:=jumlahuji+1;
if jumlahuji=maksuji then
begin
Button1.enabled:=false;
Button2.Enabled:=true;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
a:integer;
i:integer;
j:integer;
temp:TdataBobot;
pan:integer;
curr:integer;
temps:string;
begin
JData:=StrToInt(ComboBox1.Text);
Iterasi:=StrToInt(Edit1.Text);
Alpha:=StrToFloat(trim(Edit2.Text));
Miu:=StrToFloat(trim(Edit3.Text));
ErorMax:=StrToFloat(trim(Edit4.Text));
SetLength(StrIdentitas,JData);
setlength(HUnit,JumHidden);
for a:=0 to JumHidden-1 do
HUnit[a]:=HTemp[a]+1;
setlength(temp,JData);
pan:=0;
for a:=0 to JData-1 do
begin
BukaFileData(RichEdit1.Lines.Strings[a]);
temps:=copy(extractfilename(Form1.opendialog1.FileName),
1,length(extractfilename(Form1.opendialog1.FileName))-
length(extractfileext(Form1.opendialog1.FileName)));
if not inputquery('Data Name','Nama Untuk Data ke'+inttostr(a+1),temps) then
application.MessageBox(pchar('Anda tidak menekan tombol OK'+#13+'Character identified as'+temps),'Confirmation',mb_ok or mb_iconexclamation);
StrIdentitas[a]:=temps;
pan:=max(pan,length(realdata));
setlength(temp[a],length(RealData));
for i:=0 to high(RealData) do
temp[a,i]:=RealData[i];
end;
PanData:=pan;
for a:=0 to JData-1 do
begin
curr:=length(temp[a]);
if curr<pan then
begin
setlength(temp[a],pan);
for i:=curr-1 to pan-1 do
temp[a,i]:=2;
end;
end;
setlength(Masuk,JData);
for a:=0 to JData-1 do
begin
setlength(Cep,0);
PreProcessing(temp[a]);
IUnit:=length(Cep)*length(Cep[0])+1;
setlength(Masuk[a],IUnit);
Masuk[a,0]:=1;
for i:=0 to high(cep) do
for j:=0 to high(cep[i]) do
Masuk[a,i*length(Cep[i])+j+1]:=Cep[i,j];
end;
Button3.Enabled:=true;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
hasil:integer;
begin
statusbar1.Panels[0].Text:=' Training in Process..';
hasil:=DoTrain;
case hasil of
1:MessageDlg('Maximum Iteration reached',
mtInformation,[mbOk],0);
2:MessageDlg('All data can be identified',
mtInformation,[mbOk],0);
end;
Button4.Enabled:=true;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
output:T1dimensi;
out_in:T1dimensi;
hiden:Tdatabobot;
hiden_in:Tdatabobot;
target:Tdatabobot;
i:integer;
j:integer;
jhiden:integer;
curr:integer;
ounit:integer;
begin
BukaFile1.Click;
ALWavePlayer1.FileName:=opendialog1.FileName;
ALWavePlayer1.Enabled:=true;
curr:=length(realdata);
if curr<>pandata then
begin
setlength(realdata,pandata);
if curr<pandata then
for i:=curr to pandata-1 do
realdata[i]:=2;
end;
setlength(masuk,1);
setlength(cep,0);
PreProcessing(RealData);
setlength(masuk[0],iunit);
masuk[0,0]:=1;
for i:=0 to high(cep) do
for j:=0 to high(cep[i]) do
masuk[0,i*length(cep[i])+j+1]:=cep[i,j];
ounit:=InitTarget(target);
InitRead(hiden_in,hiden,out_in,output,ounit);
jhiden:=length(hunit);
LayerIn(masuk[0],hiden_in[0],vbobot[0]);
FungsiAktivasi(hiden_in[0],hiden[0]);
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
LayerIn(hiden[i],hiden_in[i+1],vbobot[i+1]);
FungsiAktivasi(hiden_in[i+1],hiden[i+1]);
end;
LayerIn(hiden[jhiden-1],out_in,wbobot);
FungsiAktivasi(out_in,output);
i:=GetDecision(output,target);
MessageDlg('Hasil Pengenalan '+StrIdentitas[i],mtInformation,[mbOk],0);
Label7.Caption:=OpenDialog1.FileName+' adalah suara = '+
StrIdentitas[i];
ALWavePlayer1.Enabled:=false;
end;
end.
// Buat Unit 2
{$N+,E+}
(*Allows code to use type 'double', run on any iX86 machine *)
{$R-}
(* Turn off range checking...we violate array bounds rules *)
unit Unit2;
interface
uses Math, Unit1;
function FrameCount(n,m,panjang:integer):integer;
procedure framing(n,m:integer;sinyal:array of double; var
hasil:Tdatabobot);
procedure pre_emphasis(koefisien:double; var sinyal:array of
double);
procedure win_sinyal(nflg:integer;kode:twindow; var win:array
of double);
const M_2PI:double=2 * 3.14159265358979323846;
implementation
function FrameCount(n,m,panjang:integer):integer;
var
a:integer;
jum:integer;
begin
a:=0;
jum:=0;
repeat
inc(jum);
inc(a,n-m);
until a>panjang;
result:=jum;
end;
procedure framing(n,m:integer;sinyal:array of double; var
hasil:Tdatabobot);
var
panjang:integer;
posisi:integer;
a:integer;
b:integer;
begin
panjang:=high(sinyal)+1;
posisi:=0;
b:=0;
repeat
for a:=0 to n-1 do
if posisi+a>=panjang then hasil[b,a]:=0
else hasil[b,a]:=sinyal[posisi+a];
inc(posisi,n-m);
inc(b);
until posisi>panjang;
end;
{
prosedur pre emphasis
koefisien -> nilai dari penguatan berkisar antara 0.9 - 1
sinyal -> sinyal yang akan dilakukan proses pre emhasis
}
procedure pre_emphasis(koefisien:double;var sinyal:array of
double);
var
temp:array of double;
a:integer;
begin
setlength(temp,high(sinyal));
for a:=1 to high(sinyal) do
temp[a]:=sinyal[a]-koefisien*sinyal[a-1];
for a:=1 to high(sinyal) do sinyal[a]:=temp[a];
end;
procedure hanning_win(var win:array of double);
var
arg:double;
a:integer;
panjang:integer;
begin
panjang:=high(win);
arg:= M_2PI/panjang;
for a:=0 to panjang do
win[a]:=0.5*(1-cos(a*arg));
end;
procedure hamming_win(var win:array of double);
var
arg:double;
a:integer;
panjang:integer;
begin
panjang:=high(win);
arg:= M_2PI /panjang;
for a:=0 to panjang do
win[a]:=0.54-0.46*cos(a*arg);
end;
procedure blackman_win(var win:array of double);
var
arg:double;
x:double;
a:integer;
panjang:integer;
begin
panjang:=high(win);
arg:=M_2PI/panjang;
for a:=0 to panjang do
begin
x:=a*arg;
win[a]:=0.42-0.5*cos(x)+0.08*cos(x+x);
end;
end;
procedure bartlett_win(var win:array of double);
var
a:integer;
pan:integer;
panjang:integer;
begin
panjang:=high(win);
pan:=panjang div 2;
for a:=0 to pan-1 do
win[a]:=2*a/pan;
for a:=pan to panjang do
win[a]:=2-2*a/pan;
end;
{
prosedur windowing sinyal
panjang -> panjang dari daerah yang akan di window
nflg -> normalisasi flag
0 -> tidak dinormalisasi
1 -> normalisasi oleh power
2 -> normalisasi oleh magnitude
kode -> kode tipe window yang dipakai
win -> koefisien hasil windowing;
}
procedure win_sinyal(nflg:integer;kode:twindow;var win:array of
double);
var
a:integer;
g:double;
panjang:integer;
begin
g:=1;
panjang:=high(win);
for a:=0 to panjang do
win[a]:=0;
case kode of
blackman:blackman_win(win);
hanning:hanning_win(win);
hamming:hamming_win(win);
bartlett:bartlett_win(win);
end;
case nflg of
0:g:=1;
1:begin
g:=0;
for a:=0 to panjang do
g:=g+sqr(win[a]);
g:=sqrt(g);
end;
2:begin
g:=0;
for a:=0 to panjang do
g:=g+win[a];
end;
end;
for a:=0 to panjang do
win[a]:=win[a]/g;
end;
end.
// Buat Unit 3
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeEngine, Series, Menus, ExtCtrls, TeeProcs, Chart, ComCtrls,
StdCtrls, ALBasicAudioOut, ALAudioOut, LPComponent, ALCommonPlayer,
ALWavePlayer, math, ImgList, acAlphaImageList, sSkinProvider,
sSkinManager, Buttons, sButton;
type
Twindow=(blackman,hanning,hamming,bartlett);
T1dimensi=array of double;
Tdatabobot=array of T1dimensi;
T3dimensi=array of Tdatabobot;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
ALWavePlayer1: TALWavePlayer;
ALAudioOut1: TALAudioOut;
RichEdit1: TRichEdit;
RichEdit2: TRichEdit;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
StatusBar1: TStatusBar;
Chart1: TChart;
File1: TMenuItem;
BukaFile1: TMenuItem;
AutoProcess1: TMenuItem;
Series1: TLineSeries;
sSkinManager1: TsSkinManager;
Exit1: TMenuItem;
Panel1: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
Label8: TLabel;
Timer1: TTimer;
BitBtn4: TBitBtn;
componen1: TMenuItem;
Hapus1: TMenuItem;
SinyalSuara1: TMenuItem;
HeaderFile1: TMenuItem;
ProcessingSpeech1: TMenuItem;
FileSpeech1: TMenuItem;
otalSuara1: TMenuItem;
JumlahHiddenLayer1: TMenuItem;
HapusSemua1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
BitBtn5: TBitBtn;
Help2: TMenuItem;
Aboutme1: TMenuItem;
BitBtn6: TBitBtn;
SaveDialog1: TSaveDialog;
Exit2: TMenuItem;
rainingnProcess1: TMenuItem;
ALLDELETE1: TMenuItem;
Button1: TsButton;
Button2: TsButton;
Button3: TsButton;
Button4: TsButton;
procedure BukaFile1Click(Sender: TObject);
procedure AutoProcess1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure SinyalSuara1Click(Sender: TObject);
procedure HeaderFile1Click(Sender: TObject);
procedure ProcessingSpeech1Click(Sender: TObject);
procedure FileSpeech1Click(Sender: TObject);
procedure otalSuara1Click(Sender: TObject);
procedure JumlahHiddenLayer1Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure Aboutme1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure Exit2Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure HapusSemua1Click(Sender: TObject);
procedure rainingnProcess1Click(Sender: TObject);
procedure ALLDELETE1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
MATHPHI=3.1415926535897932384626433832795;
MAXDATA=15000;//15000 sample
UKURANFRAME=2048;
FREKUENSI=12000;//12 KHz sample rate
var
Form1: TForm1;
maksuji,jumlahuji :word;
PosisiFile :Byte;
JData :integer;
Iterasi :integer;
Alpha:double;
Miu:double;
ErorMax:double;
StrIdentitas:array of string;
HUnit:array of integer;
JumHidden:Byte;
HTemp:array of integer;
RealData:array of double;
PanData:Integer;
Masuk:Tdatabobot;
Cep:Tdatabobot;
IUnit:Integer;
wbobot:Tdatabobot;
vbobot:array of Tdatabobot;
implementation
uses Unit2, Unit3, Unit4, Fourier;
{$R *.dfm}
procedure BukaFileData(const namafile:string);
var
F:File of Smallint;
dumdata:Smallint;
loop:word;
begin
AssignFile(F,namafile);
Reset(F);
Seek(F,0);
SetLength(RealData,MAXDATA);
for loop:=0 to MAXDATA-1 do
begin
Read(F,dumdata);
RealData[loop]:=dumdata;
end;
CloseFile(F);
end;
//--------------------------------
procedure LaporkanKeMemo(const namafile:string);
begin
with Form1, Memo1.Lines do
begin
Clear;
Add('Buka File : '+namafile);
Add('File speech dengan header File :');
Add('- RIFF chunck');
Add('- Mode Mono');
Add('- 12 KHZ sample rate');
Add('- 16 bit signed data');
Add('- 15000 sample data = 1.25 s');
end;
end;
//-------------------------------
procedure GraphikkanKeWave;
var
loop:word;
begin
with Form1, Series1 do
begin
Clear;
for loop:=0 to MAXDATA-1 do
Add(RealData[loop]);
end;
end;
//--------------------------------------
Procedure TampilkanProsess(proses:Byte);
var
loop1:Byte;
loop2:Byte;
begin
with Form1, RichEdit2.Lines do
begin
case proses of
0:begin
Clear;
Add('PreProcessing :');
end;
1:Add('Baca Data Sinyal Speech ...');
2:Add('Framing Data ...');
3:Add('PreEmphasis ...');
4:Add('Windowing ...');
5:Add('FFT ...');
6:Add('LPC ...');
7:Add('Cepstral ...');
100:
begin
Add('SUKSESS ...');
Add('------------------------------');
Add('Jumlah Koefisien Cepstral :'+FloatToStr(high(Cep)+1));
Add('Jumlah Frame :'+FloatToStr(high(Cep[1])+1));
for loop1:=0 to high(Cep) do
begin
Add('==============================');
for loop2:=0 to high(Cep[loop1]) do
Add('Frame['+IntToStr(loop2)+']'+'Coef['+IntToStr(loop1)+']'+
#9+ FloatToStr(Cep[loop1,loop2]));
end;
end;
end;
end;
end;
//--------------------------------
//------------------------------------------
procedure PreProcessing(sinyal:array of double);
var
p:integer;
i:integer;
j:integer;
win:array of double;
aut:array of double;
realtime:Tdatabobot;
imgtime:Tdatabobot;
realfrek:Tdatabobot;
imgfrek:Tdatabobot;
jumframe:integer;
begin
TampilkanProsess(0);
TampilkanProsess(1);
jumframe:=FrameCount(UKURANFRAME,UKURANFRAME div 3,
high(sinyal)+1);
setlength(realtime,jumframe);
setlength(imgtime,jumframe);
setlength(realfrek,jumframe);
setlength(imgfrek,jumframe);
setlength(Cep,jumframe);
TampilkanProsess(2);
pre_emphasis(0.94,sinyal);
setlength(realtime,jumframe);
for i:=0 to jumframe-1 do
begin
setlength(realtime[i],UKURANFRAME);
setlength(imgtime[i],UKURANFRAME);
setlength(realfrek[i],UKURANFRAME);
setlength(imgfrek[i],UKURANFRAME);
end;
TampilkanProsess(3);
framing(UKURANFRAME,UKURANFRAME div 3,sinyal,realtime);
TampilkanProsess(4);
setlength(win,UKURANFRAME);
win_sinyal(0,hanning,win);
TampilkanProsess(5);
for i:=0 to jumframe-1 do
for j:=0 to UKURANFRAME-1 do
realtime[i,j]:=realtime[i,j]*win[j];
for i:=0 to jumframe-1 do
fft(UKURANFRAME,realtime[i],imgtime[i],realfrek[i],imgfrek[i]);
for i:=0 to jumframe-1 do
for j:=0 to UKURANFRAME-1 do
realfrek[i,j]:=sqrt(sqr(realfrek[i,j])+sqr(imgfrek[i,j]));
TampilkanProsess(6);
p:=MakeOrder(FREKUENSI);
setlength(aut,p+1);
for i:=0 to jumframe-1 do
begin
setlength(Cep[i],p+1);
LPCAnalisis(realfrek[i],UKURANFRAME,p,aut);
lpc2cepstral(p,p,aut,Cep[i]);
weightingcepstral(p,Cep[i]);
end;
TampilkanProsess(7);
TampilkanProsess(100);
end;
//---------------------------------
function InitTarget(var target:Tdatabobot):integer;
var
a:integer;
b:integer;
sisa:integer;
ounit:integer;
begin
setlength(target,jdata);
sisa:=jdata mod 3;
if sisa<>0 then
sisa:=1;
ounit:=jdata div 3 +sisa+1;
for a:=0 to jdata-1 do
begin
setlength(target[a],ounit);
for b:=1 to ounit-1 do
target[a,b]:=0.1;
target[a,1+ a div 3]:=0.3+ 0.3*(a mod 3);
end;
result:=ounit;
end;
//-----------------------------------------
function CekBobotAll(hiden_in,hiden:Tdatabobot;
out_in,output:t1dimensi;
target:Tdatabobot;jhiden:integer):boolean;
var
i:integer;
num:integer;
kenal:integer;
sum:double;
begin
result:=false;
kenal:=0;
for num:=0 to high(masuk) do
begin
//---------feedforrward proses---------//
LayerIn(masuk[num],hiden_in[0],vbobot[0]);
FungsiAktivasi(hiden_in[0],hiden[0]);
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
LayerIn(hiden[i],hiden_in[i+1],vbobot[i+1]);
FungsiAktivasi(hiden_in[i+1],hiden[i+1]);
end;
LayerIn(hiden[jhiden-1],out_in,wbobot);
FungsiAktivasi(out_in,output);
sum:=0;
for i:=1 to high(output) do
sum:=sum+abs(output[i]-target[num,i]);
sum:=sum/jdata;
if sum<ErorMax then
inc(kenal);
end;
if kenal=jdata then
result:=true;
end;
//--------------------------------------------
procedure InitTrain(var vbobotold:T3dimensi;var
wbobotold:Tdatabobot;
var hiden,hiden_in,eror_j:Tdatabobot;var
output,out_in,eror_k:T1dimensi;
ounit:integer);
var
i:integer;
j:integer;
jhiden:integer;
begin
setlength(hiden,length(hunit));
setlength(hiden_in,length(hunit));
setlength(eror_j,length(hunit));
for i:=0 to high(hunit) do
begin
setlength(hiden[i],hunit[i]);
setlength(hiden_in[i],hunit[i]);
setlength(eror_j[i],hunit[i]);
hiden[i,0]:=1;
end;
setlength(output,ounit);
setlength(out_in,ounit);
setlength(eror_k,ounit);
setlength(vbobot,length(hunit));
setlength(vbobotold,length(hunit));
setlength(vbobot[0],iunit);
setlength(vbobotold[0],iunit);
for i:=0 to iunit-1 do
begin
setlength(vbobot[0,i],hunit[0]);
setlength(vbobotold[0,i],hunit[0]);
end;
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
setlength(vbobot[i+1],hunit[i]);
setlength(vbobotold[i+1],hunit[i]);
for j:=0 to hunit[i]-1 do
begin
setlength(vbobot[i+1,j],hunit[i+1]);
setlength(vbobotold[i+1,j],hunit[i+1]);
end;
end;
jhiden:=length(hunit);
setlength(wbobot,hunit[jhiden-1]);
setlength(wbobotold,hunit[jhiden-1]);
for i:=0 to hunit[jhiden-1]-1 do
begin
setlength(wbobot[i],ounit);
setlength(wbobotold[i],ounit);
end;
InisialisasiBobot(vbobot,wbobot);
end;
//-----------------------------------------
function DoTrain:integer;
var
vbobotold:T3dimensi;
wbobotold:Tdatabobot;
output:T1dimensi;
out_in:T1dimensi;
eror_k:T1dimensi;
hiden:Tdatabobot;
hiden_in:Tdatabobot;
eror_j:Tdatabobot;
target:Tdatabobot;
loop:integer;
num:integer;
jhiden:integer;
i:integer;
j:integer;
kenal:integer;
ounit:integer;
sum:double;
sumall:double;
begin
jhiden:=length(hunit);
ounit:=InitTarget(target);
InitTrain(vbobotold,wbobotold,hiden,hiden_in,eror_j,
output,out_in,eror_k,ounit);
for loop:=1 to iterasi do
begin
kenal:=0;
sumall:=0;
application.ProcessMessages;
for num:=0 to high(masuk) do
begin
//---------feedforrward proses---------//
LayerIn(masuk[num],hiden_in[0],vbobot[0]);
FungsiAktivasi(hiden_in[0],hiden[0]);
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
LayerIn(hiden[i],hiden_in[i+1],vbobot[i+1]);
FungsiAktivasi(hiden_in[i+1],hiden[i+1]);
end;
LayerIn(hiden[jhiden-1],out_in,wbobot);
FungsiAktivasi(out_in,output);
//----------------cek target yg dicapai-----------
if loop mod 10=0 then
begin
sum:=0;
for i:=1 to high(output) do
sum:=sum+abs(output[i]-target[num,i]);
sum:=sum/jdata;
if sum<ErorMax then
inc(kenal);
sumall:=sumall+sum;
Form1.statusbar1.Panels[1].Text:=' Data identify'+inttostr(kenal)+ ' from '+inttostr(jdata)+ ' at'+inttostr(loop)+' epoch';
if num=high(masuk) then
Form1.statusbar1.Panels[2].Text:=' Error ='+floattostr(sumall/jdata);
if kenal=jdata then if CekBobotAll(hiden_in,hiden,out_in,output,target,jhiden) then
begin
result:=2;
exit;
end;
end;
//------backforward proses----------//
CalculateOutputEror(target[num],output,out_in,eror_k);
CalculateHidenEror(eror_k,hiden_in[jhiden-1],
wbobot,eror_j[jhiden-1]);
if high(hunit)>0 then
for i:=high(hunit) downto 1 do
CalculateHidenEror(eror_j[i],hiden_in[i-1],vbobot[i],
eror_j[i-1]);
//---------update bobot------------//
UpdateBobot(alpha,miu,eror_k,hiden[jhiden-1],wbobot,wbobotold);
UpdateBobot(alpha,miu,eror_j[0],masuk[num],vbobot[0],
vbobotold[0]);
if high(hunit)>0 then
for i:=high(hunit) downto 1 do
UpdateBobot(alpha,miu,eror_j[i],hiden[i-1],vbobot[i],
vbobotold[i]);
end;
end;
result:=1;//-------normal exit
end;
//----------------------------------
procedure InitRead(var hiden_in,hiden:Tdatabobot;
var out_in,output:T1dimensi;ounit:integer);
var
i:integer;
begin
setlength(hiden,length(hunit));
setlength(hiden_in,length(hunit));
for i:=0 to high(hunit) do
begin
setlength(hiden[i],hunit[i]);
setlength(hiden_in[i],hunit[i]);
hiden[i,0]:=1;
end;
setlength(output,ounit);
setlength(out_in,ounit);
end;
//---------------------------------
function
GetDecision(output:t1dimensi;target:Tdatabobot):integer ;
var
i:integer;
j:integer;
sum:double;
min_e:double;
begin
min_e:=1000;
result:=0;
for i:=0 to high(target) do
begin
sum:=0;
for j:=1 to high(target[i]) do
sum:=sum+abs(output[j]-target[i,j]);
if min_e>sum then
begin
result:=i;
min_e:=sum;
end;
end;
end;
procedure TForm1.BukaFile1Click(Sender: TObject);
begin
with OpenDialog1 do
begin
Title:='Buka File Data';
Filter:='data File (*.wav)|*.wav';
DefaultExt:='dat';
FileName:='';
InitialDir:=ExtractFileDir(ParamStr(0))+'\data';
if Execute then
begin
BukaFileData(FileName);
LaporkanKeMemo(FileName);
GraphikkanKeWave;
end;
end;
AutoProcess1.Enabled:=true;
end;
procedure TForm1.AutoProcess1Click(Sender: TObject);
begin
PreProcessing(RealData);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
jumlahuji:=0;
Button1.enabled:=true;
Button2.enabled:=false;
end;
procedure TForm1.ComboBox2Change(Sender: TObject);
var
a:integer;
temp:string;
begin
JumHidden:=strtoint(ComboBox2.Text);
setlength(HTemp,JumHidden);
for a:=0 to JumHidden-1 do
begin
temp:='25';
inputquery('Jumlah Unit Hiden Ke -'+inttostr(a+1), 'Jumlah Unit :',temp);
HTemp[a]:=strtoint(temp);
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
with OpenDialog1 do
begin
Title:='Buka File Data';
Filter:='data File (*.wav)|*.wav';
DefaultExt:='dat';
FileName:='';
InitialDir:=ExtractFileDir(ParamStr(0))+'\data';
if Execute then
begin
BukaFileData(FileName);
LaporkanKeMemo(FileName);
GraphikkanKeWave;
end;
end;
AutoProcess1.Enabled:=true;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
close
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
PreProcessing(RealData);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
label8.Left := label8.Left - 5;
if label8.Left <= -100 then
label8.Left := 550;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
memo1.Clear;
richedit1.Clear;
richedit2.Clear;
combobox1.ClearSelection;
combobox2.ClearSelection;
Series1.Clear;
statusbar1.Panels[0].Text:='';
statusbar1.Panels[1].Text:='';
statusbar1.Panels[2].Text:='';
label7.Caption:='';
end;
procedure TForm1.SinyalSuara1Click(Sender: TObject);
begin
Series1.Clear;
end;
procedure TForm1.HeaderFile1Click(Sender: TObject);
begin
memo1.Clear;
end;
procedure TForm1.ProcessingSpeech1Click(Sender: TObject);
begin
richedit1.Clear;
end;
procedure TForm1.FileSpeech1Click(Sender: TObject);
begin
richedit2.Clear;
end;
procedure TForm1.otalSuara1Click(Sender: TObject);
begin
combobox1.ClearSelection;
end;
procedure TForm1.JumlahHiddenLayer1Click(Sender: TObject);
begin
combobox2.ClearSelection;
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
begin
MessageDlg ('Pengenalan Suara Menggunakan Jaringan Syaraf Tiruan' + #13 +
'JST adalah suatu teknologi komputasi yg berbasis pada model syaraf biologis dan mencoba mensimulasikan tingkah laku dan kerja model syaraf terhadap berbagai macam masukan ' + #13 +
'"Mastering Delphi 7" written by Muhammad Ichsan',
mtInformation, [mbOk], 0);
end;
procedure TForm1.Aboutme1Click(Sender: TObject);
begin
MessageDlg ('Pengenalan Suara Menggunakan Jaringan Syaraf Tiruan' + #13 +
'JST adalah suatu teknologi komputasi yg berbasis pada model syaraf biologis dan mencoba mensimulasikan tingkah laku dan kerja model syaraf terhadap berbagai macam masukan ' + #13 +
'"Mastering Delphi 7" written by Muhammad Ichsan',
mtInformation, [mbOk], 0);
end;
procedure TForm1.About1Click(Sender: TObject);
begin
Panel1.Visible := not Panel1.Visible;
About1.Checked := Panel1.Visible;
end;
procedure TForm1.BitBtn6Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
richedit2.Lines.SaveToFile (SaveDialog1.FileName);
end;
end;
procedure TForm1.Exit2Click(Sender: TObject);
begin
close ;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
begin
Memo1.Lines.SaveToFile (SaveDialog1.FileName);
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if MessageDlg('Apakah anda yakin untuk'+#13+'keluar dari program ini ?',
mtConfirmation,[mbYes,mbNo],0)=mrNo then
CanClose:=False;
end;
procedure TForm1.HapusSemua1Click(Sender: TObject);
begin
label7.Caption:='';
end;
procedure TForm1.rainingnProcess1Click(Sender: TObject);
begin
statusbar1.Panels[0].Text:='';
statusbar1.Panels[1].Text:='';
statusbar1.Panels[2].Text:='';
end;
procedure TForm1.ALLDELETE1Click(Sender: TObject);
begin
memo1.Clear;
richedit1.Clear;
richedit2.Clear;
combobox1.ClearSelection;
combobox2.ClearSelection;
Series1.Clear;
statusbar1.Panels[0].Text:='';
statusbar1.Panels[1].Text:='';
statusbar1.Panels[2].Text:='';
label7.Caption:='';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
maksuji:=strtoint(ComboBox1.text);
with OpenDialog1 do
begin
Title:='Buka File Data';
Filter:='data File (*.wav)|*.wav';
DefaultExt:='wav';
FileName:='';
InitialDir:=ExtractFileDir(ParamStr(0))+'\data';
if Execute then
begin
inc(PosisiFile);
RichEdit1.Lines.Add(FileName);
end;
end;
jumlahuji:=jumlahuji+1;
if jumlahuji=maksuji then
begin
Button1.enabled:=false;
Button2.Enabled:=true;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
a:integer;
i:integer;
j:integer;
temp:TdataBobot;
pan:integer;
curr:integer;
temps:string;
begin
JData:=StrToInt(ComboBox1.Text);
Iterasi:=StrToInt(Edit1.Text);
Alpha:=StrToFloat(trim(Edit2.Text));
Miu:=StrToFloat(trim(Edit3.Text));
ErorMax:=StrToFloat(trim(Edit4.Text));
SetLength(StrIdentitas,JData);
setlength(HUnit,JumHidden);
for a:=0 to JumHidden-1 do
HUnit[a]:=HTemp[a]+1;
setlength(temp,JData);
pan:=0;
for a:=0 to JData-1 do
begin
BukaFileData(RichEdit1.Lines.Strings[a]);
temps:=copy(extractfilename(Form1.opendialog1.FileName),
1,length(extractfilename(Form1.opendialog1.FileName))-
length(extractfileext(Form1.opendialog1.FileName)));
if not inputquery('Data Name','Nama Untuk Data ke'+inttostr(a+1),temps) then
application.MessageBox(pchar('Anda tidak menekan tombol OK'+#13+'Character identified as'+temps),'Confirmation',mb_ok or mb_iconexclamation);
StrIdentitas[a]:=temps;
pan:=max(pan,length(realdata));
setlength(temp[a],length(RealData));
for i:=0 to high(RealData) do
temp[a,i]:=RealData[i];
end;
PanData:=pan;
for a:=0 to JData-1 do
begin
curr:=length(temp[a]);
if curr<pan then
begin
setlength(temp[a],pan);
for i:=curr-1 to pan-1 do
temp[a,i]:=2;
end;
end;
setlength(Masuk,JData);
for a:=0 to JData-1 do
begin
setlength(Cep,0);
PreProcessing(temp[a]);
IUnit:=length(Cep)*length(Cep[0])+1;
setlength(Masuk[a],IUnit);
Masuk[a,0]:=1;
for i:=0 to high(cep) do
for j:=0 to high(cep[i]) do
Masuk[a,i*length(Cep[i])+j+1]:=Cep[i,j];
end;
Button3.Enabled:=true;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
hasil:integer;
begin
statusbar1.Panels[0].Text:=' Training in Process..';
hasil:=DoTrain;
case hasil of
1:MessageDlg('Maximum Iteration reached',
mtInformation,[mbOk],0);
2:MessageDlg('All data can be identified',
mtInformation,[mbOk],0);
end;
Button4.Enabled:=true;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
output:T1dimensi;
out_in:T1dimensi;
hiden:Tdatabobot;
hiden_in:Tdatabobot;
target:Tdatabobot;
i:integer;
j:integer;
jhiden:integer;
curr:integer;
ounit:integer;
begin
BukaFile1.Click;
ALWavePlayer1.FileName:=opendialog1.FileName;
ALWavePlayer1.Enabled:=true;
curr:=length(realdata);
if curr<>pandata then
begin
setlength(realdata,pandata);
if curr<pandata then
for i:=curr to pandata-1 do
realdata[i]:=2;
end;
setlength(masuk,1);
setlength(cep,0);
PreProcessing(RealData);
setlength(masuk[0],iunit);
masuk[0,0]:=1;
for i:=0 to high(cep) do
for j:=0 to high(cep[i]) do
masuk[0,i*length(cep[i])+j+1]:=cep[i,j];
ounit:=InitTarget(target);
InitRead(hiden_in,hiden,out_in,output,ounit);
jhiden:=length(hunit);
LayerIn(masuk[0],hiden_in[0],vbobot[0]);
FungsiAktivasi(hiden_in[0],hiden[0]);
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
LayerIn(hiden[i],hiden_in[i+1],vbobot[i+1]);
FungsiAktivasi(hiden_in[i+1],hiden[i+1]);
end;
LayerIn(hiden[jhiden-1],out_in,wbobot);
FungsiAktivasi(out_in,output);
i:=GetDecision(output,target);
MessageDlg('Hasil Pengenalan '+StrIdentitas[i],mtInformation,[mbOk],0);
Label7.Caption:=OpenDialog1.FileName+' adalah suara = '+
StrIdentitas[i];
ALWavePlayer1.Enabled:=false;
end;
end.
// Buat Unit 2
{$N+,E+}
(*Allows code to use type 'double', run on any iX86 machine *)
{$R-}
(* Turn off range checking...we violate array bounds rules *)
unit Unit2;
interface
uses Math, Unit1;
function FrameCount(n,m,panjang:integer):integer;
procedure framing(n,m:integer;sinyal:array of double; var
hasil:Tdatabobot);
procedure pre_emphasis(koefisien:double; var sinyal:array of
double);
procedure win_sinyal(nflg:integer;kode:twindow; var win:array
of double);
const M_2PI:double=2 * 3.14159265358979323846;
implementation
function FrameCount(n,m,panjang:integer):integer;
var
a:integer;
jum:integer;
begin
a:=0;
jum:=0;
repeat
inc(jum);
inc(a,n-m);
until a>panjang;
result:=jum;
end;
procedure framing(n,m:integer;sinyal:array of double; var
hasil:Tdatabobot);
var
panjang:integer;
posisi:integer;
a:integer;
b:integer;
begin
panjang:=high(sinyal)+1;
posisi:=0;
b:=0;
repeat
for a:=0 to n-1 do
if posisi+a>=panjang then hasil[b,a]:=0
else hasil[b,a]:=sinyal[posisi+a];
inc(posisi,n-m);
inc(b);
until posisi>panjang;
end;
{
prosedur pre emphasis
koefisien -> nilai dari penguatan berkisar antara 0.9 - 1
sinyal -> sinyal yang akan dilakukan proses pre emhasis
}
procedure pre_emphasis(koefisien:double;var sinyal:array of
double);
var
temp:array of double;
a:integer;
begin
setlength(temp,high(sinyal));
for a:=1 to high(sinyal) do
temp[a]:=sinyal[a]-koefisien*sinyal[a-1];
for a:=1 to high(sinyal) do sinyal[a]:=temp[a];
end;
procedure hanning_win(var win:array of double);
var
arg:double;
a:integer;
panjang:integer;
begin
panjang:=high(win);
arg:= M_2PI/panjang;
for a:=0 to panjang do
win[a]:=0.5*(1-cos(a*arg));
end;
procedure hamming_win(var win:array of double);
var
arg:double;
a:integer;
panjang:integer;
begin
panjang:=high(win);
arg:= M_2PI /panjang;
for a:=0 to panjang do
win[a]:=0.54-0.46*cos(a*arg);
end;
procedure blackman_win(var win:array of double);
var
arg:double;
x:double;
a:integer;
panjang:integer;
begin
panjang:=high(win);
arg:=M_2PI/panjang;
for a:=0 to panjang do
begin
x:=a*arg;
win[a]:=0.42-0.5*cos(x)+0.08*cos(x+x);
end;
end;
procedure bartlett_win(var win:array of double);
var
a:integer;
pan:integer;
panjang:integer;
begin
panjang:=high(win);
pan:=panjang div 2;
for a:=0 to pan-1 do
win[a]:=2*a/pan;
for a:=pan to panjang do
win[a]:=2-2*a/pan;
end;
{
prosedur windowing sinyal
panjang -> panjang dari daerah yang akan di window
nflg -> normalisasi flag
0 -> tidak dinormalisasi
1 -> normalisasi oleh power
2 -> normalisasi oleh magnitude
kode -> kode tipe window yang dipakai
win -> koefisien hasil windowing;
}
procedure win_sinyal(nflg:integer;kode:twindow;var win:array of
double);
var
a:integer;
g:double;
panjang:integer;
begin
g:=1;
panjang:=high(win);
for a:=0 to panjang do
win[a]:=0;
case kode of
blackman:blackman_win(win);
hanning:hanning_win(win);
hamming:hamming_win(win);
bartlett:bartlett_win(win);
end;
case nflg of
0:g:=1;
1:begin
g:=0;
for a:=0 to panjang do
g:=g+sqr(win[a]);
g:=sqrt(g);
end;
2:begin
g:=0;
for a:=0 to panjang do
g:=g+win[a];
end;
end;
for a:=0 to panjang do
win[a]:=win[a]/g;
end;
end.
// Buat Unit 3
{$N+,E+}
(* Allows code to use type 'double' run on any iX86 machine *)
{$R-}
(* Turn off range checking...we violate array bounds rules *)
unit Unit3;
interface
uses math,Unit1;
function LPCAnalisis(sinyal:array of
double;framelength,p:integer;var a:array of double):integer;
function MakeOrder(BandWith:integer):integer;
procedure lpc2cepstral(p1,p2:integer;a:array of double;var
c:array of double);
procedure weightingcepstral(p:integer;var c:array of double);
const M_PI:double=3.14159265358979323846;
implementation
function MakeOrder(BandWith:integer):integer;
begin
result:=2*(BandWith div 1000+1);
end;
//-----------------------------------------//
{
fungsi autokorelasi untuk meminimalisasi mse dari LPC
p -> order dari prediksi
r -> koefisien autokorelasi
frame_length -> panjang frame
sinyal -> data sinyal
hasil procedure adalah :
koefisien autokorelasi
}
//-----------------------------------------//
procedure autocorelation(sinyal:array of
double;frame_length,p:integer;var r:array of double);
var a,b:integer;
temp :double;
begin
for a:=0 to p do
begin
temp:=0;
for b:=0 to frame_length-1-a do
temp:=temp+sinyal[b]*sinyal[b+a];
r[a]:=temp;
end;
end;
//-----------------------------------------//
{
fungsi untuk mencari koefisien prediksi dari LPC
r -> koefisien autokorelasi
p -> order dari prediksi
eps -> singular check
kp -> koefisien prediksi
hasil fungsi adalah :
0 -> normaly completed
1 -> abnormaly completed
2 -> unstable LPC
}
//-----------------------------------------//
function CariKoefisienPrediksi(r:array of
double;p:integer;eps:double;var kp:array of double):integer;
var rmd,mue :double;
a,b,flag:integer;
c :array of double;
begin
flag:=0;
setlength(c,p+1);
if eps<0.0 then eps:=1.0e-6;
rmd :=r[0];
kp[0]:=0;
for a:=1 to p do
begin
mue:= -r[a];
for b:=1 to a-1 do
mue:=mue - c[b] * r[a - b];
mue:= mue/rmd;
for b:=1 to a-1 do
kp[b]:= c[b] + mue * c[a - b];
kp[a]:=mue;
rmd:=(1.0 - mue * mue) * rmd;
if rmd<0 then
rmd:=-rmd;
if rmd<=eps then
begin
result:=1;
exit;
end;
if mue<0 then
mue:=-mue;
if mue>=1 then
flag:=2;
for b:= 0 to a do
c[b]:=kp[b];
end;
kp[0]:=sqrt(rmd);
result:=flag;
end;
function Gain(p:integer;a:array of double;r:array of
double):double;
var b:integer;
temp:double;
begin
temp:=0;
for b:=1 to p do
temp:=temp+a[b]*r[b];
temp:=r[0]-temp;
result:=sqrt(temp);
end;
//-----------------------------------------//
{
prosedur untuk menganalisa LPC
frame_length -> panjang frame
sinyal -> data sinyal
p -> order dari lpc
a -> koefisien dari lpc
hasilnya adalah apakah lpc kita stabil atau nggak
}
//-----------------------------------------//
function LPCAnalisis(sinyal:array of
double;framelength,p:integer;var a:array of double):integer;
var r :array of double;
flag,b,c:integer;
temp :double;
sinpred :array of double;
begin
setlength(r,p+1);
setlength(sinpred,framelength);
autocorelation(sinyal,framelength,p,r);
flag:=CariKoefisienPrediksi(r,p,-1,a);
for b:=1 to framelength-1 do
begin
temp:=0;
for c:=1 to p do
if b-c>=0 then
temp:=temp+sinyal[b-c]*a[c];
sinpred[b]:=temp;
end;
result:=flag;
end;
//-----------------------------------------//
{
prosedur untuk mencari koefisien cepstral
p1 -> order dari lpc
p2 -> order dari cepstral
a -> koefisien dari lpc
c -> koefisien dari cepstral
hasilnya adalah koefisien cepstral -> c
}
//-----------------------------------------//
procedure lpc2cepstral(p1,p2:integer;a:array of double;var
c:array of double);
var i,j,k :integer;
temp :double;
begin
c[0]:=log10(a[0]);
c[1]:=-a[1];
for i:=2 to p2 do
begin
j:=i;
if i>p1 then k:=i-p1
else k:=1;
temp:=0;
repeat
temp:=temp+k*c[k]*a[i-k];
inc(k);
until k>=j;
c[i]:=-temp/i;
if i<=p1 then c[i]:=c[i]-a[i];
end;
end;
//-----------------------------------------//
{
prosedur untuk pembobotan koefisien cepstral untuk mengurangi
sensitivitas
p -> order dari cepstral
c -> koefisien dari cepstral
hasilnya adalah koefisien cepstral yang telah di boboti -> c
}
//-----------------------------------------//
procedure weightingcepstral(p:integer;var c:array of double);
var a:integer;
w:array of double;
arg:double;
begin
setlength(w,p+1);
arg:=M_PI/p;
for a:=1 to p do
w[a]:=1+(p/2)*sin(a*arg);
for a:=1 to p do
c[a]:=c[a]*w[a];
end;
end.
// Buat Unit 4
(* Allows code to use type 'double' run on any iX86 machine *)
{$R-}
(* Turn off range checking...we violate array bounds rules *)
unit Unit3;
interface
uses math,Unit1;
function LPCAnalisis(sinyal:array of
double;framelength,p:integer;var a:array of double):integer;
function MakeOrder(BandWith:integer):integer;
procedure lpc2cepstral(p1,p2:integer;a:array of double;var
c:array of double);
procedure weightingcepstral(p:integer;var c:array of double);
const M_PI:double=3.14159265358979323846;
implementation
function MakeOrder(BandWith:integer):integer;
begin
result:=2*(BandWith div 1000+1);
end;
//-----------------------------------------//
{
fungsi autokorelasi untuk meminimalisasi mse dari LPC
p -> order dari prediksi
r -> koefisien autokorelasi
frame_length -> panjang frame
sinyal -> data sinyal
hasil procedure adalah :
koefisien autokorelasi
}
//-----------------------------------------//
procedure autocorelation(sinyal:array of
double;frame_length,p:integer;var r:array of double);
var a,b:integer;
temp :double;
begin
for a:=0 to p do
begin
temp:=0;
for b:=0 to frame_length-1-a do
temp:=temp+sinyal[b]*sinyal[b+a];
r[a]:=temp;
end;
end;
//-----------------------------------------//
{
fungsi untuk mencari koefisien prediksi dari LPC
r -> koefisien autokorelasi
p -> order dari prediksi
eps -> singular check
kp -> koefisien prediksi
hasil fungsi adalah :
0 -> normaly completed
1 -> abnormaly completed
2 -> unstable LPC
}
//-----------------------------------------//
function CariKoefisienPrediksi(r:array of
double;p:integer;eps:double;var kp:array of double):integer;
var rmd,mue :double;
a,b,flag:integer;
c :array of double;
begin
flag:=0;
setlength(c,p+1);
if eps<0.0 then eps:=1.0e-6;
rmd :=r[0];
kp[0]:=0;
for a:=1 to p do
begin
mue:= -r[a];
for b:=1 to a-1 do
mue:=mue - c[b] * r[a - b];
mue:= mue/rmd;
for b:=1 to a-1 do
kp[b]:= c[b] + mue * c[a - b];
kp[a]:=mue;
rmd:=(1.0 - mue * mue) * rmd;
if rmd<0 then
rmd:=-rmd;
if rmd<=eps then
begin
result:=1;
exit;
end;
if mue<0 then
mue:=-mue;
if mue>=1 then
flag:=2;
for b:= 0 to a do
c[b]:=kp[b];
end;
kp[0]:=sqrt(rmd);
result:=flag;
end;
function Gain(p:integer;a:array of double;r:array of
double):double;
var b:integer;
temp:double;
begin
temp:=0;
for b:=1 to p do
temp:=temp+a[b]*r[b];
temp:=r[0]-temp;
result:=sqrt(temp);
end;
//-----------------------------------------//
{
prosedur untuk menganalisa LPC
frame_length -> panjang frame
sinyal -> data sinyal
p -> order dari lpc
a -> koefisien dari lpc
hasilnya adalah apakah lpc kita stabil atau nggak
}
//-----------------------------------------//
function LPCAnalisis(sinyal:array of
double;framelength,p:integer;var a:array of double):integer;
var r :array of double;
flag,b,c:integer;
temp :double;
sinpred :array of double;
begin
setlength(r,p+1);
setlength(sinpred,framelength);
autocorelation(sinyal,framelength,p,r);
flag:=CariKoefisienPrediksi(r,p,-1,a);
for b:=1 to framelength-1 do
begin
temp:=0;
for c:=1 to p do
if b-c>=0 then
temp:=temp+sinyal[b-c]*a[c];
sinpred[b]:=temp;
end;
result:=flag;
end;
//-----------------------------------------//
{
prosedur untuk mencari koefisien cepstral
p1 -> order dari lpc
p2 -> order dari cepstral
a -> koefisien dari lpc
c -> koefisien dari cepstral
hasilnya adalah koefisien cepstral -> c
}
//-----------------------------------------//
procedure lpc2cepstral(p1,p2:integer;a:array of double;var
c:array of double);
var i,j,k :integer;
temp :double;
begin
c[0]:=log10(a[0]);
c[1]:=-a[1];
for i:=2 to p2 do
begin
j:=i;
if i>p1 then k:=i-p1
else k:=1;
temp:=0;
repeat
temp:=temp+k*c[k]*a[i-k];
inc(k);
until k>=j;
c[i]:=-temp/i;
if i<=p1 then c[i]:=c[i]-a[i];
end;
end;
//-----------------------------------------//
{
prosedur untuk pembobotan koefisien cepstral untuk mengurangi
sensitivitas
p -> order dari cepstral
c -> koefisien dari cepstral
hasilnya adalah koefisien cepstral yang telah di boboti -> c
}
//-----------------------------------------//
procedure weightingcepstral(p:integer;var c:array of double);
var a:integer;
w:array of double;
arg:double;
begin
setlength(w,p+1);
arg:=M_PI/p;
for a:=1 to p do
w[a]:=1+(p/2)*sin(a*arg);
for a:=1 to p do
c[a]:=c[a]*w[a];
end;
end.
// Buat Unit 4
{$N+,E+}
(* Allows code to use type 'double' run on any iX86 machine *)
{$R-}
(* Turn off range checking...we violate array bounds rules *)
unit Unit4;
interface
uses math, Unit1;
procedure InisialisasiBobot(var vbobot:array of Tdatabobot;var
wbobot:Tdatabobot);
procedure LayerIn(prev:array of double;var
next:T1dimensi;bobot:Tdatabobot);
procedure FungsiAktivasi(inp:array of double;var hasil:array of
double);
procedure CalculateOutputEror(target,output,out_in:array of
double;var eror_k:array of double);
procedure CalculateHidenEror(eror_next,hiden_in:array of
double;bobot:Tdatabobot;var eror_j:array of double);
procedure
UpdateBobot(alpha,miu:double;eror_next,prev_data:array of
double;var bobot,oldbobot:Tdatabobot);
implementation
procedure RandomBobot(var bobot:Tdatabobot);
var a,b:integer;
begin
for a:=0 to high(bobot) do
for b:=0 to high(bobot[a]) do
bobot[a,b]:=random-0.5;
end;
procedure NguyenWidrow(var bobot:tdatabobot);
var beta:double;
a,b :integer;
old :double;
UnitInput,UnitHiden:integer;
begin
UnitInput:=high(bobot);
UnitHiden:=high(bobot[0]);
beta:=0.7*(power(UnitHiden,1/UnitInput));
for a:=1 to UnitHiden do
begin
old:=0;
for b:=1 to UnitInput-1 do
old:=old+sqr(bobot[b,a]);
old:=sqrt(old);
for b:=1 to UnitInput-1 do
bobot[b,a]:=beta*bobot[b,a]/old;
bobot[0,a]:=beta*(1-2*random);
end;
end;
function sigmoid(nilai:real):real ;
begin
result:=1/(1+(exp(-nilai)));
end;
function TurunanSigmoid(nilai:real):real ;
begin
result:= sigmoid(nilai)*(1-sigmoid(nilai));
end;
procedure InisialisasiBobot(var vbobot:array of Tdatabobot;var
wbobot:Tdatabobot);
var a:integer;
begin
RandomBobot(vbobot[0]);
NguyenWidrow(vbobot[0]);
if high(vbobot)>0 then
for a:=1 to high(vbobot) do
RandomBobot(vbobot[a]);
RandomBobot(wbobot);
end;
procedure LayerIn(prev:array of double;var
next:T1dimensi;bobot:Tdatabobot);
var a,b:integer;
begin
for a:=1 to high(next) do
begin
next[a]:=bobot[0,a];
for b:=1 to high(prev) do
next[a]:=next[a]+bobot[b,a]*prev[b];
end;
end;
procedure FungsiAktivasi(inp:array of double;var hasil:array of
double);
var a:integer;
begin
for a:=1 to high(hasil) do
hasil[a]:=sigmoid(inp[a]);
end;
procedure CalculateOutputEror(target,output,out_in:array of
double;var eror_k:array of double);
var a:integer;
begin
for a:=1 to high(target) do
eror_k[a]:=(target[a]-output[a])*TurunanSigmoid(out_in[a]);
end;
procedure CalculateHidenEror(eror_next,hiden_in:array of
double;bobot:Tdatabobot;var eror_j:array of double);
var a,b:integer;
eror_in:double;
begin
for a:=1 to high(bobot) do
begin
eror_in:=0;
for b:=1 to high(bobot[a]) do
eror_in:=eror_in+eror_next[b]*bobot[a,b];
eror_j[a]:=eror_in*TurunanSigmoid(hiden_in[a]);
end;
end;
procedure
UpdateBobot(alpha,miu:double;eror_next,prev_data:array of
double;var bobot,oldbobot:Tdatabobot);
var a,b:integer;
temp:Tdatabobot;
begin
setlength(temp,high(bobot)+1);
for a:=0 to high(bobot) do
begin
setlength(temp[a],high(bobot[a])+1);
for b:=0 to high(bobot[a]) do
temp[a,b]:=bobot[a,b];
end;
for a:=0 to high(bobot) do
for b:=0 to high(bobot[a]) do
bobot[a,b]:=bobot[a,b]+alpha*eror_next[b]*prev_data[a]+miu*(bobot[a,b]-oldbobot[a,b]);
for a:=0 to high(bobot) do
for b:=0 to high(bobot[a]) do
oldbobot[a,b]:=temp[a,b];
end;
end.
// Buat Unit Fourier
{$N+,E+} (* Allows code to use type 'double' and run on any
iX86 machine *)
{$R-} (* Turn off range checking...we violate array bounds
rules *)
unit Fourier;
interface
procedure fft (
NumSamples: word; // positiF integer pgkt 2
var RealIn: array of double;
var ImagIn: array of double;
var RealOut: array of double;
var ImagOut: array of double );
procedure ifft (
NumSamples: word; // positiF integer pgkt 2
var RealIn: array of double;
var ImagIn: array of double;
var RealOut: array of double;
var ImagOut: array of double );
procedure fft_integer (
NumSamples: word;
var RealIn: array of integer;
var ImagIn: array of integer;
var RealOut: array of double;
var ImagOut: array of double );
procedure fft_integer_cleanup;
procedure CalcFrequency (
NumSamples: word; // positif integer
FrequencyIndex: word; // 0 .. NumSamples-1
var RealIn: array of double;
var ImagIn: array of double;
var RealOut: double;
var ImagOut: double );
function MakePowerOfTwo(nilai:integer ):integer;
procedure fftlain(dir,m:integer;var x,y:array of double);
implementation
function IsPowerOfTwo ( x: word ): boolean;
var i, y: word;
begin
y := 2;
for i := 1 to 15 do begin
if x = y then begin
IsPowerOfTwo := TRUE;
exit;
end;
y := y SHL 1;
end;
IsPowerOfTwo := FALSE;
end;
function NumberOfBitsNeeded ( PowerOfTwo: word ): word;
var i: word;
begin
for i := 0 to 16 do begin
if (PowerOfTwo AND (1 SHL i)) <> 0 then begin
NumberOfBitsNeeded := i;
exit;
end;
end;
end;
function ReverseBits ( index, NumBits: word ): word;
var i, rev: word;
begin
rev := 0;
for i := 0 to NumBits-1 do begin
rev := (rev SHL 1) OR (index AND 1);
index := index SHR 1;
end;
ReverseBits := rev;
end;
function MakePowerOfTwo(nilai:integer ):integer;
var val,a:integer;
begin
if val<=2 then
result:=2;
val:=2;
repeat
val:= val shl 1;
until val>=nilai;
result:=val;
end;
procedure FourierTransform (
AngleNumerator: double;
NumSamples: word;
var RealIn: array of double;
var ImagIn: array of double;
var RealOut: array of double;
var ImagOut: array of double );
var
NumBits, i, j, k, n, BlockSize, BlockEnd: word;
delta_angle, delta_ar: double;
alpha, beta: double;
tr, ti, ar, ai: double;
begin
if not IsPowerOfTwo(NumSamples) or (NumSamples<2) then
begin
write ( 'Error in procedure Fourier: NumSamples=',
NumSamples );
writeln ( ' is not a positive integer power of 2.' );
halt;
end;
NumBits := NumberOfBitsNeeded (NumSamples);
for i := 0 to NumSamples-1 do begin
j := ReverseBits ( i, NumBits );
RealOut[j] := RealIn[i];
ImagOut[j] := ImagIn[i];
end;
BlockEnd := 1;
BlockSize := 2;
while BlockSize <= NumSamples do begin
delta_angle := AngleNumerator / BlockSize;
alpha := sin ( 0.5 * delta_angle );
alpha := 2.0 * alpha * alpha;
beta := sin ( delta_angle );
i := 0;
while i < NumSamples do begin
ar := 1.0; (* cos(0) *)
ai := 0.0; (* sin(0) *)
j := i;
for n := 0 to BlockEnd-1 do begin
k := j + BlockEnd;
tr := ar*RealOut[k] - ai*ImagOut[k];
ti := ar*ImagOut[k] + ai*RealOut[k];
RealOut[k] := RealOut[j] - tr;
ImagOut[k] := ImagOut[j] - ti;
RealOut[j] := RealOut[j] + tr;
ImagOut[j] := ImagOut[j] + ti;
delta_ar := alpha*ar + beta*ai;
ai := ai - (alpha*ai - beta*ar);
ar := ar - delta_ar;
INC(j);
end;
i := i + BlockSize;
end;
BlockEnd := BlockSize;
BlockSize := BlockSize SHL 1;
end;
end;
procedure fft (
NumSamples: word;
var RealIn: array of double;
var ImagIn: array of double;
var RealOut: array of double;
var ImagOut: array of double );
begin
FourierTransform ( 2*PI, NumSamples, RealIn, ImagIn,
RealOut, ImagOut );
end;
procedure ifft (
NumSamples: word;
var RealIn: array of double;
var ImagIn: array of double;
var RealOut: array of double;
var ImagOut: array of double );
var
i: word;
begin
FourierTransform ( -2*PI, NumSamples, RealIn, ImagIn,
RealOut, ImagOut );
(* Normalize the resulting time samples... *)
for i := 0 to NumSamples-1 do begin
RealOut[i] := RealOut[i] / NumSamples;
ImagOut[i] := ImagOut[i] / NumSamples;
end;
end;
type
doubleArray = array [0..0] of double;
var
RealTemp, ImagTemp: ^doubleArray;
TempArraySize: word;
procedure fft_integer (
NumSamples: word;
var RealIn: array of integer;
var ImagIn: array of integer;
var RealOut: array of double;
var ImagOut: array of double );
var
i: word;
begin
if NumSamples > TempArraySize then begin
fft_integer_cleanup; { free up memory in case we
already have some. }
GetMem ( RealTemp, NumSamples * sizeof(double) );
GetMem ( ImagTemp, NumSamples * sizeof(double) );
TempArraySize := NumSamples;
end;
for i := 0 to NumSamples-1 do begin
RealTemp^[i] := RealIn[i];
ImagTemp^[i] := ImagIn[i];
end;
FourierTransform (
2*PI,
NumSamples,
RealTemp^, ImagTemp^,
RealOut, ImagOut );
end;
procedure fft_integer_cleanup;
begin
if TempArraySize > 0 then begin
if RealTemp <> NIL then begin
FreeMem ( RealTemp, TempArraySize * sizeof(double) );
RealTemp := NIL;
end;
if ImagTemp <> NIL then begin
FreeMem ( ImagTemp, TempArraySize * sizeof(double) );
ImagTemp := NIL;
end;
TempArraySize := 0;
end;
end;
procedure CalcFrequency (
NumSamples: word; { must be integer power of 2 }
FrequencyIndex: word; { must be in the range 0 ..
NumSamples-1 }
var RealIn: array of double;
var ImagIn: array of double;
var RealOut: double;
var ImagOut: double );
var
k: word;
cos1, cos2, cos3, theta, beta: double;
sin1, sin2, sin3: double;
begin
RealOut := 0.0;
ImagOut := 0.0;
theta := 2*PI * FrequencyIndex / NumSamples;
sin1 := sin ( -2 * theta );
sin2 := sin ( -theta );
cos1 := cos ( -2 * theta );
cos2 := cos ( -theta );
beta := 2 * cos2;
for k := 0 to NumSamples-1 do begin
{ Update trig values }
sin3 := beta*sin2 - sin1;
sin1 := sin2;
sin2 := sin3;
cos3 := beta*cos2 - cos1;
cos1 := cos2;
cos2 := cos3;
RealOut := RealOut + RealIn[k]*cos3 - ImagIn[k]*sin3;
ImagOut := ImagOut + ImagIn[k]*cos3 + RealIn[k]*sin3;
end;
end;
procedure fftlain(dir,m:integer;var x,y:array of double);
var nn,i,i1,j,k,i2,l,l1,l2:longint;
c1,c2,tx,ty,t1,t2,u1,u2,z:double;
begin
nn:=1;
for i:=0 to m do
nn:=nn*2;
i2:=nn shr 1;
j:=0;
for i:=0 to nn-1 do
begin
if i<j then
begin
tx:=x[i];
ty:=y[i];
x[i]:=x[j];
y[i]:=y[j];
x[j]:=tx;
y[j]:=ty;
end;
k:=i2;
while k<=j do
begin
j:=j-k;
k:=k shr 1;
end;
j:=j+k;
end;
c1:=-1.0;
c2:=0.0;
l2:=1;
for l:=0 to m do
begin
l1:=l2;
l2:=l2 shl 1;
u1:=1.0;
u2:=0.0;
for j:=0 to 11 do
begin
i:=j;
repeat
i1:=i+l1;
t1:=u1*x[i1]-u2*y[i1];
t2:=u1*y[i1]+u2*x[i1];
x[i1]:=x[i]-t1;
y[i1]:=y[i]-t2;
x[i]:=x[i]+t1;
y[i]:=y[i]+t2;
inc(i,l2);
until i>=nn;
z:=u1*c1-u2*c2;
u2:=u1*c2+u2*c1;
u1:=z;
end;
c2:=sqrt((1.0-c1)/2.0);
if dir=1 then
c2:=-c2;
c1:=sqrt((1.0+c1)/2.0);
end;
if dir=1 then
for i:=0 to nn do
begin
x[i]:=x[i]/nn;
y[i]:=y[i]/nn;
end;
end;
end.
Download Jaringan Syaraf Tiruan
link downloadnya tidak bisa gan
BalasHapusKomentar ini telah dihapus oleh pengarang.
BalasHapussorry gan baru nongol, link.a sudah d perbaiki...
BalasHapus