unit UnitProcFrm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, StdCtrls, Dialogs, Grids, Controls;

type
    AofInt= array of integer;

{ TClsGrid }

TClsGrid= class(TObject)
private
       fslIndex, fslCellTable, fslClasses: TStringList;
       fexpField, fpredField: string;
       fclBM: AofInt;
       fsumBM, fSumStrs, fNoStr, fCurrMolC: integer;
       fgotoFix: boolean;
       fiMem: integer;
public
      property slIndex: TStringList read fslIndex write fslIndex;
      property slCellTable: TStringList read fslCellTable write fslCellTable;
      property slClasses: TStringList read fslClasses write fslClasses;
      property expField: string read fexpField write fexpField;
      property predField: string read fpredField write fpredField;
      property sumBM: integer read fsumBM write fsumBM;
      property clBM: AofInt read fclBM write fclBM;
      //property SumStrs: integer read fSumStrs write fSumStrs;
      property NoStr: integer read fNoStr write fNoStr;
      property CurrMolC: integer read fCurrMolC write fCurrMolC;
      property iMem: integer read fiMem write fiMem;
      property gotoFix: boolean read fgotoFix write fgotoFix;
      constructor Create;
      destructor Destroy; override;
      procedure LoadTXTFile(FrgCmpSG: TStringGrid; LabelCell: TLabel; txtFileName: string);
      procedure InitclBM;
      procedure SetSzeclBM(sze: integer);
      procedure SetExpPredField(expnam, prednam: string);
      procedure LoadGrid(FrgCmpSG: TStringGrid);
      function GetCellSum(iniline: string): string;
      procedure CollectClasses(nRec: integer; pline: string; var eline: string);
      procedure GetCellBM(rcLine:string; var expClass, predClass: string);
      procedure GotoMol(MolNo: Integer; expClass, predClass: string; var LabelCell: TLabel);
      procedure GotoCurMolC(expClass, predClass: string; var LabelCell: TLabel);
      procedure AddToMemoC(MemoC: TMemo; FrgCmpSG: TStringGrid);
end;

function GetFieldNames(SDFFile: TStringList): TStringList; //Warning creates its TStringList
procedure GetComboBoxes(BxExp, BxPred: TComboBox; SDFFile: TStringList);

implementation

//______________________________________________________________________________
//
//  GetFieldNames : SDF field names containing integer values
//______________________________________________________________________________
function GetFieldNames(SDFFile: TStringList): TStringList; //Warning creates its TStringList
var
   i, j, k  : Integer;
   NewField : Boolean;
   OneLine  : string;
   nmfLine  : string;
begin
     Result:=TStringList.Create;
     NewField := FALSE;
     k := SDFFile.Count-1;
     for i:=0 to k do begin
         OneLine := SDFFile[i];
         if Pos('$$$$', OneLine)>0 then Break;  // take fields of one record only
         if Pos('>  <', OneLine)=1 then begin
            OneLine := Copy(OneLine,5,Length(OneLine));
            if Pos('>',OneLine)>0 then begin
               OneLine := Trim(Copy(OneLine,1,Pred(Pos('>',OneLine))));
               NewField := TRUE;
               for j:=0 to Result.Count-1 do begin
                   if OneLine=Result[j] then begin
                      NewField := FALSE;
                      Break;
                   end;
               end;
               if NewField then nmfLine := OneLine;
            end;
         end else begin
             if NewField then begin
                try
                   StrToInt(Trim(OneLine));
                   Result.Add(nmfLine);
                except
                      ;
                end;
                NewField := FALSE;
             end;
         end;
     end;  // i = 0..ii
     Result.Sort;
     Result.Sorted := TRUE;
end;  // GetFieldNames


procedure GetComboBoxes(BxExp, BxPred: TComboBox; SDFFile: TStringList);
var
   i, k     : Integer;
   slFields: TStringList;
begin
     BxExp.Clear;
     BxPred.Clear;
     slFields:=GetFieldNames(SDFFile);
     k := slFields.Count-1;
     if k<1 then begin
        MessageDlg('SDF file have less than 2 fields with integer data concerning classification!', mtInformation, [mbOk], 0);
     end;
     for i:=0 to k do begin
         BxExp.Items.Add(slFields[i]);
         BxPred.Items.Add(slFields[i]);
     end;
     BxExp.ItemIndex := 0;
     //expField := BxExp.Items[BxExp.ItemIndex];
     if k>0 then BxPred.ItemIndex := 1 else BxPred.ItemIndex := 0;
     //predField := BxPred.Items[BxPred.ItemIndex];
     //
     FreeAndNil(slFields);
end;

//______________________________________________________________________________
//
//  LoadGrid
//______________________________________________________________________________

{ TClsGrid }

constructor TClsGrid.Create;
begin
     fexpField:='';
     fpredField:='';
     fsumBM:=0;
     fSumStrs:=0;
     fNoStr:=0;
     fCurrMolC:=0;
     fiMem:=0;
     fgotoFix:=False;
     fslIndex:=TStringList.Create;
     fslCellTable:=TStringList.Create;
     fslClasses:=TStringList.Create;
end;

destructor TClsGrid.Destroy;
begin
     FreeAndNil(fslIndex);
     FreeAndNil(fslCellTable);
     FreeAndNil(fslClasses);
     inherited Destroy;
end;

//______________________________________________________________________________
//
//   LoadTXTFile
//______________________________________________________________________________
procedure TClsGrid.LoadTXTFile(FrgCmpSG: TStringGrid; LabelCell: TLabel; txtFileName: string);
const
     a0 = 12;
var
   i, j, k, L: Integer;
   nMol      : Integer;
   OneLine   : string;
   eLine     : string;
   pLine     : string;
   sLine     : string;
   exps, preds : string;
   msgStop   : word;
   FixWriteE : Boolean;
   FixWriteP : Boolean;
   FixWriteS : Boolean;
   F0txt     : TextFile;
begin
     fslIndex.Clear;
     fslCellTable.Clear;
     fslClasses.Clear;
     FrgCmpSG.Row:=1;
     FrgCmpSG.Col:=1;
     AssignFile(F0txt, txtFileName);
     Reset(F0txt);
     j := 0;
     k := 0;
     nMol := 0;
     repeat
           FixWriteE := FALSE;
           FixWriteP := FALSE;
           FixWriteS := FALSE;
           Readln(F0txt, OneLine);
           j := j+1;
           // exp. value
           OneLine := Trim(OneLine);
           L := Length(OneLine);
           i := Pos(' ',OneLine);
           eLine := Copy(OneLine,1,i-1);
           OneLine := Copy(OneLine,i+1,L);
           try
              StrToInt(eLine);
              FixWriteE := TRUE;
           except
           ;
           end;
           // pred. value
           OneLine := Trim(OneLine);
           L := Length(OneLine);
           i := Pos(' ',OneLine);
           pLine := Copy(OneLine,1,i-1);
           OneLine := Copy(OneLine,i+1,L);
           try
              StrToInt(pLine);
              FixWriteP := TRUE;
           except
           ;
           end;
           // no. of structure
           OneLine := Trim(OneLine);
           i := Pos(' ',OneLine);
           if i>0 then
              sLine := Copy(OneLine,1,i-1)
           else
           sLine := OneLine;
           try
              nMol := StrToInt(sLine);
              FixWriteS := TRUE;
           except
           ;
           end;
           // collect data
           if FixWriteE and FixWriteP and FixWriteS then begin
              CollectClasses(nMol-1, pLine, eLine);
              k := k+1;
           end;
     until EOF(F0txt);
     CloseFile(F0txt);
     slClasses.Sort;
     if j<>k then
        MessageDlg(IntToStr(j)+' lines are read, only '+IntToStr(k)+' lines contain of query data.', mtInformation, [mbOk], 0);
     if slClasses.Count>a0 then begin
        msgStop := MessageDlg('Maybe, there are too many classes ('+IntToStr(slClasses.Count)+'). Stop downloading?', mtConfirmation, [mbYes, mbNo], 0);
        if msgStop=mrYes then Exit;
     end;
     SetLength(fclBM, nMol+1);
     for i:=0 to nMol do fclBM[i] := 0;
     // start output
     LoadGrid(FrgCmpSG);  ///
     with FrgCmpSG do begin
          Col:=1;
          Row:=1;
          exps:=Cells[Col,0];
          preds:=Cells[0,Row];
     end;
     OneLine := exps+' '+preds;
     GetCellBM(OneLine,exps,preds);
     GotoCurMolC(exps,preds,LabelCell);
     //AddToMemoC;  ///
end;  // LoadTXTFile

procedure TClsGrid.InitclBM;
var
   i: integer;
begin
     for i:=Low(fclBM) to High(fclBM) do fclBM[i]:=0;
end;

procedure TClsGrid.SetSzeclBM(sze: integer);
begin
     SetLength(fclBM,sze);
     InitclBM;
end;

procedure TClsGrid.SetExpPredField(expnam, prednam: string);
begin
     fexpField:=expnam;
     fpredField:=prednam;
end;

procedure TClsGrid.LoadGrid(FrgCmpSG: TStringGrid);
var
   i, j, m  : Integer;
   iCol     : Integer;
   iRow     : Integer;
   rcLine   : string;
begin
     m := slClasses.Count;
     FrgCmpSG.RowCount := m+2;
     FrgCmpSG.ColCount := m+2;
     FrgCmpSG.Cells[0, 0] := '      exp. -->';
     // titles
     for iCol:=1 to m do begin
         iRow := iCol;
         i := iCol-1;
         FrgCmpSG.Cells[iCol, 0] := slClasses[i];
         FrgCmpSG.Cells[0, iRow] := slClasses[i];
     end;
     FrgCmpSG.Cells[0, FrgCmpSG.RowCount-1] := 'exp. TOTAL';
     FrgCmpSG.Cells[FrgCmpSG.ColCount-1, 0] := 'pred. TOTAL';
     // data
     for iRow:=1 to m do begin
         for iCol:=1 to m do begin
             rcLine := FrgCmpSG.Cells[iCol, 0]+' '+FrgCmpSG.Cells[0, iRow];
             rcline:=GetCellSum(rcLine);
             FrgCmpSG.Cells[iCol, iRow] := rcLine;
         end;
     end;
     // exp. TOTAL sums
     j := m+1;
     for iCol:=1 to m do begin
         i := 0;
         for iRow:=1 to m do i := i+StrToInt(FrgCmpSG.Cells[iCol, iRow]);
         FrgCmpSG.Cells[iCol, j] := IntToStr(i);
     end;
     // pred. TOTAL sums
     j := m+1;
     for iRow:=1 to m do begin
         i := 0;
         for iCol:=1 to m do i := i+StrToInt(FrgCmpSG.Cells[iCol, iRow]);
         FrgCmpSG.Cells[j, iRow] := IntToStr(i);
     end;
end;  // LoadGrid

//______________________________________________________________________________
//
//  GetCellSum : number elements in the cell
//______________________________________________________________________________
function TClsGrid.GetCellSum(iniline: string): string;
var
   i, j, k, m, L : Integer;
   //icLine        : string;
   StartCell     : Boolean;
   rcline: string;
begin
     k := 0;
     m := slIndex.Count-1;
     StartCell := FALSE;
     for i:=0 to m do begin
         if iniline=slIndex[i] then begin
            StartCell := TRUE;
            k := i;
            Break;
         end;
     end;
     if StartCell then begin
        rcline := slCellTable[k];
        L := Length(rcLine);
        j := 1;
        for i:=1 to L do begin
            if rcLine[i]=' ' then begin
               j := j+1;
            end;
        end;
        rcLine := IntToStr(j);
     end else begin
         rcLine := '0';
     end;
     Result:=rcline;
end;  // GetCellSum

//____________________________________________________________________________
//
//  CollectClasses
//____________________________________________________________________________
procedure TClsGrid.CollectClasses(nRec: integer; pline: string; var eline: string);
var
   j, m       : Integer;
   indLine    : string;
   StartCell  : Boolean;
   StartClass : Boolean;
begin
     // classes
     m := slClasses.Count-1;
     StartClass := TRUE;
     for j:=0 to m do begin
         if eLine=slClasses[j] then begin
            StartClass := FALSE;
            Break;
         end;
     end;
     if StartClass then begin
        slClasses.Add(eLine);
     end;
     // cells
     indLine := eLine+' '+pLine;
     m := slIndex.Count-1;
     StartCell := TRUE;
     for j:=0 to m do begin
         if indLine=slIndex[j] then begin
            slCellTable[j] := slCellTable[j]+' '+IntToStr(nRec+1);
            StartCell := FALSE;
            Break;
         end;
     end;
     if StartCell then begin
        slIndex.Add(indLine);
        slCellTable.Add(IntToStr(nRec+1));
     end;
end;  // CollectClasses

//______________________________________________________________________________
//
//  GetCellBM : bookmarks for selected Cell of Classes
//______________________________________________________________________________
procedure TClsGrid.GetCellBM(rcLine: string; var expClass, predClass: string);
var
   i, j, m, L : Integer;
   iCell      : Integer;
   icLine     : string;
   sym        : string;
   StartCell  : Boolean;
begin
     iCell := 0;
     fsumBM := 0;
     CurrMolC :=1;
     m := slIndex.Count-1;
     StartCell := FALSE;
     i:=0;
     while ((i<m+1) and (rcLine<>slIndex[i])) do inc(i);
     if rcLine=slIndex[i] then begin
            StartCell := TRUE;
            iCell := i;
     end;
     if StartCell then begin
        icLine := slCellTable[iCell];
        L := Length(icLine);
        j := 0;
        sym := '';
        for i:=1 to L do begin
            if icLine[i]<>' ' then begin
               sym := sym+icLine[i];
            end else begin
                try
                   j := j+1;
                   fclBM[j] := StrToInt(sym);
                   sym := '';
                except
                      fsumBM := j-1;
                      MessageDlg('Error at creation of bookmarks!', mtError, [mbOk], 0);
                      Exit;
                end;
            end;
        end;
        try
           j := j+1;
           fclBM[j] := StrToInt(sym);
           fsumBM := j;
        except
              fsumBM := j-1;
        end;
        icLine := slIndex[iCell];
        L := Length(icLine);
        j := Pos(' ',icLine);
        expClass  := Copy(icLine,1,j-1);
        predClass := Copy(icLine,j+1,L);
     end;
end;  // GetCellBM

//______________________________________________________________________________
//
//  GotoMol
//______________________________________________________________________________
procedure TClsGrid.GotoMol(MolNo: Integer; expClass, predClass: string; var LabelCell: TLabel);
var
   i      : Integer;
   phLine : string;
   curFix : Boolean;
begin
     if fsumBM<1 then begin
        LabelCell.Caption := '';
        Exit;
     end;
     if MolNo<1 then begin
        NoStr := 1;
     end;
     if MolNo>fSumStrs then begin
        NoStr := fSumStrs;
     end;
     if (MolNo>0) and (MolNo<=fSumStrs) then begin
        NoStr := MolNo;
     end;
     // labels
     curFix := TRUE;
     if gotoFix then begin
        curFix := FALSE;
        for i:=1 to fsumBM do begin
            if MolNo=fclBM[i] then begin
               CurrMolC := i;
               curFix := TRUE;
               Break;
            end;
        end;
        gotoFix := FALSE;
     end;
     if curFix then begin
        phLine := phLine+' of '+IntToStr(fsumBM)+' of Cell['+expClass+', '+predClass+'] )';
        LabelCell.Caption := 'Looking at Record: '+IntToStr(MolNo)+' ( '+IntToStr(CurrMolC)+phLine;
     end else begin
         LabelCell.Caption := 'Looking at Record: '+IntToStr(MolNo);
     end;
  // load mol
  // SDFInput2(SDFFile);  ///
  // FormViewMol.PaintBoxStructure.Refresh;
  // FormViewMol.MoleculeDraw(FormViewMol.PaintBoxStructure);
end;  // GotoMol

procedure TClsGrid.GotoCurMolC(expClass, predClass: string; var LabelCell: TLabel);
begin
     GotoMol(fclBM[fCurrMolC],expClass,predClass,LabelCell);
end;

//______________________________________________________________________________
//
//   AddToMemoC
//______________________________________________________________________________
procedure TClsGrid.AddToMemoC(MemoC: TMemo; FrgCmpSG: TStringGrid);
var
   i, m       : Integer;
   iRow, iCol : Integer;
   OneLine, expClass, predClass    : string;
begin
     with FrgCmpSG do begin
          expClass:=Cells[Col,0];
          predClass:=Cells[0,Row];
     end;
     Inc(iMem);
     MemoC.Lines.Add('');
     MemoC.Lines.Add('< '+IntToStr(iMem)+' >');
     m := FrgCmpSG.RowCount-1;
     MemoC.Lines.Add('      CONFUSION MATRIX');
     for iRow:=0 to m do
         OneLine := OneLine+'-------';
     MemoC.Lines.Add(OneLine);
     MemoC.Lines.Add('             exp.(actual)');
     for iRow:=0 to m do begin
         OneLine := '';
         for iCol:=0 to m do begin
             try
                i := StrToInt(FrgCmpSG.Cells[iCol, iRow]);
                OneLine := OneLine+Format('%7d', [i]);
             except
                   OneLine := OneLine+'       ';
             end;
         end;
         if iRow=0 then OneLine := OneLine+'<-- exp.class';
         if iRow=m then OneLine := OneLine+'<-- exp.TOTAL';
         MemoC.Lines.Add(OneLine);
     end;
     OneLine := '';
     for iRow:=0 to m do
         OneLine := OneLine+'-------';
     MemoC.Lines.Add(OneLine);
     MemoC.Lines.Add('_________ Cell ['+expClass+', '+predClass+'] _________');
     MemoC.Lines.Add('');
     MemoC.Lines.Add('Exp. Class:            '+expClass);
     MemoC.Lines.Add('Pred. Class:           '+predClass);
     MemoC.Lines.Add('Records in the Cell:   '+IntToStr(fsumBM));
end;  // AddToMemoC

end.

