unit LCDatabase;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, Classifier, DBClassifier, StdCtrls, Grids,
  DBGrids, MtxVec, ClipBrd, Probabilities, ExtCtrls, ComCtrls, Spin, Basic2;

type
  TLcDatabaseForm = class(TForm)
    procedure Button2Click(Sender: TObject);
    procedure RunButtonClick(Sender: TObject);
    procedure CopyButtonClick(Sender: TObject);
    procedure ClassifierGroupClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TablesBoxChange(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure UserTableAfterScroll(DataSet: TDataSet);
    procedure KNeighborsEditChange(Sender: TObject);
  private
    procedure RunTest(TableNames: TStringList; Index: integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  LcDatabaseForm: TLcDatabaseForm;

implementation

{$R *.DFM}


procedure TLcDatabaseForm.Button2Click(Sender: TObject);
begin
     Close;
end;

procedure TLcDatabaseForm.RunTest(TableNames: TStringList; Index: integer);
var  i,j,k,Runs: integer;
     a,b,c,d: array of double;
     TimeMark: TDateTime;
begin
    Runs := RunsEdit.Value;
    SetLength(a,Runs);
    SetLength(b,Runs);
    SetLength(c,Runs);
    SetLength(d,Runs);
    TimeMark := Now;
    LC.UsePriorProbability := True;
    for i := 0 to TableNames.Count-1 do
    begin
         if TableNames[i] = 'Test1.DB' then Continue;
         if NoSatiBox.Checked and (TableNames[i] = 'SATI.DB') then Continue;
         DataTable.TableName := TableNames[i];
         DataTable.Open;
         TableLabel.Caption := 'Current database table: ' + TableNames[i];
         Update;
         DBLC.Clear;
         if PruningBox.Checked and not (DataTable.TableName = 'SATI.DB') then
         begin
             SplitLabel.Caption := 'Optimizing...';
             Update;
             LC.UsePriorProbability := True;
             DataTable.Filtered := False;
             DBLC.LearnData;
             DBLC.Classifier.Prune;
         end;
         if Runs = 1 then DataTable.Filtered := False else DataTable.Filtered := True;
         for j := 0 to Runs-1 do
         begin
             DataTable.Filter := '[Split' + IntToStr(j) + '] = 0';   {Learn examples}
             SplitLabel.Caption := 'Split number: ' + IntToStr(j);
             Update;
             DBLC.Classifier.SoftReset;
             DBLC.LearnData;
             DataTable.Filter := '[Split' + IntToStr(j) + '] = 1';   {Test examples}
             a[j] := DBLC.ClassifyTest;
             b[j] := DataTable.RecordCount;
             if DBLC.Classifier = NB then c[j] := NB.MaxPriorProbability(k);
             if DBLC.Classifier = LC then d[j] := LC.MaxEntropy(k);
         end;
         ResultGrid.Cells[0,i+1] := TableNames[i];
         ResultGrid.Cells[Index,  i+1] := FormatFloat('0.00',Mean(a)) + '+/-' + FormatFloat('0.00',StdDev(a,Mean(a)));
         ResultGrid.Cells[4, i+1] := FormatFloat('0.00',Mean(b)) + '+/-' + FormatFloat('0.00',StdDev(b,Mean(b)));
         if DBLC.Classifier = NB then
         ResultGrid.Cells[5, i+1] := FormatFloat('0.00',Mean(c)) + '+/-' + FormatFloat('0.00',StdDev(c,Mean(c)));
         if DBLC.Classifier = LC then
         ResultGrid.Cells[6, i+1] := FormatFloat('0.00',Mean(d)) + '+/-' + FormatFloat('0.00',StdDev(d,Mean(d)));
         DataTable.Close;
    end;
    TimeMark := Now-TimeMark;
    ResultGrid.Cells[0,TableNames.Count+1] := 'Time [min:sec]';
    ResultGrid.Cells[Index, TableNames.Count+1] := FormatDateTime('nn:ss',TimeMark);
end;

procedure TLcDatabaseForm.RunButtonClick(Sender: TObject);
var TableNames: TStringList;
begin
    TableNames := TStringList.Create;
    TableNames.Sorted := True;
    DataTable.Close;
    DataTable.Filter := '';
    DataTable.Filtered := True;

    ResultGrid.Cells[4, 0] := 'Test examples';
    ResultGrid.Cells[5, 0] := 'Prior probability';
    ResultGrid.Cells[6, 0] := 'Best attr. succ.[%]';

    DBLC.Classifier := LC;
    ClassifierGroup.ItemIndex := 0;
    DataTable.DatabaseName := 'AIData'; {Runs on continuous records}
    Session.GetTableNames('AIData','*.DB',True,false, TableNames);
    ResultGrid.Cells[1,0] := 'LC Success [%]';
    RunTest(TableNames,1);

    DBLC.Classifier := NB;  {Naive bayes can only run on discrete attributes}
    ClassifierGroup.ItemIndex := 1;
    DataTable.DatabaseName := 'AIDataD';  {Runs on discrete records}
    Session.GetTableNames('AIDataD','*.DB',True,false, TableNames);
    ResultGrid.Cells[2,0] := 'NB Success [%]';
    RunTest(TableNames,2);

    DBLC.Classifier := KNN;
    ClassifierGroup.ItemIndex := 2;
    DataTable.DatabaseName := 'AIData';   {Runs on continuous records}
    Session.GetTableNames('AIData','*.DB',True,false, TableNames);
    ResultGrid.Cells[3,0] := 'KNN Success [%]';
    RunTest(TableNames,3);

    TableNames.Destroy;
end;

procedure TLcDatabaseForm.CopyButtonClick(Sender: TObject);
var AList: TStringList;
    a: string;
    i,j: integer;
begin
    AList := TStringList.Create;
    for i := 0 to ResultGrid.RowCount-1 do
    begin
         a := '';
         for j := 0 to ResultGrid.ColCount-1 do a := a + Chr(9) + ResultGrid.Cells[j,i];
         AList.Add(a);
    end;
    Clipboard.AsText := Alist.Text;
    AList.Destroy;
end;

procedure TLcDatabaseForm.ClassifierGroupClick(Sender: TObject);
begin
      Case ClassifierGroup.ItemIndex of
      0: DBLC.Classifier := LC;
      1: DBLC.Classifier := NB;
      2: DBLC.Classifier := KNN;
      end;
end;

procedure TLcDatabaseForm.FormCreate(Sender: TObject);
var TableNames: TStringList;
begin
    TableNames := TStringList.Create;
    UserTable.Close;
    UserTable.DatabaseName := 'AIDataD';  {Runs on discrete records}
    Session.GetTableNames('AIDataD','*.DB',True,false, TableNames);
    TablesBox.Items.Assign(TableNames);
    TablesBox.ItemIndex := 6;
    TablesBoxChange(Sender);
    TableNames.Destroy;
end;

procedure TLcDatabaseForm.TablesBoxChange(Sender: TObject);
begin
       DBLC.Clear;
       UserTable.Close;
       UserTable.TableName := TablesBox.Text;
       UserTable.Open;
       DBLC.LearnData;
end;

procedure TLcDatabaseForm.PageControl1Change(Sender: TObject);
begin
       case PageControl1.ActivePageIndex of
        0: DBLC.Dataset := DataTable;
        1: DBLC.Dataset := UserTable;
       end;
       DBLC.ClassField := 'Class';
       DBLC.Clear;
       DBLC.LearnData;
end;

procedure TLcDatabaseForm.UserTableAfterScroll(DataSet: TDataSet);
begin
    IDLabel.Caption := 'ID: ' + IntToStr(UserTable['ID']);
    if not DBLC.IsUpdating then
    GuessedClassLabel.Caption := 'Guessed class: ' + DBLC.ClassifyRecord;
    ActualClassLabel.Caption := 'Actual class: ' + FloatToStr(UserTable['Class']);
end;

procedure TLcDatabaseForm.KNeighborsEditChange(Sender: TObject);
begin
    KNN.KNeighbors := KNeighborsEdit.Value;
end;

initialization
   RegisterClass(TLcDatabaseForm);
end.
