unit UnitClsTbl;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Grids, UnitClsStats;

type
    TAofI = array of integer;
    TAofD = array of double;
    TAofI2 = array of array of integer;
    //
    PTClsData = ^TClsData;
    TClsData = record
             Id: Integer;//SDF ID
             PredID: Integer;
             Exp: Integer;
             Preds: TAofI;
             Confidence: TAofD;
    end;
    PTCelltbl = ^TCelltbl;
    TCelltbl = record
             Pop, BMf,BMl: integer;
    end;
    TAofCll2 = array of array of TCelltbl;
    //

    { TClsTbl }

    TClsTbl = class(TList)
    private
           fNCls, fNPred, fPredID: integer;
           fSDFflenme: string;
           fWeights: TAofD;
           fCurrM,fCurrE,fCurrP: integer;//Current position in the list and in the array as Exp/Pred
           procedure SetPredID(ID: integer);
           procedure SetLngthPPrds;
           procedure SetLngthClsPrds;
           procedure InitClsPrds;
    public
          constructor Create;
          destructor Destroy; override;
          procedure Clear; override;
          procedure ReadTXT(nme: string);
          procedure ReadOUT(nme: string);
          procedure SortOn(ID: integer);
          procedure SetLengthWeight(Sze: integer);
          procedure FillClsPrds;
          function GetClsPrds: TCelltbl;
          function SetCurrM(Exp,Pred: integer): boolean;//True if succeeded
          function FirstCurrM: boolean;
          function PrevCurrM: boolean;
          function NextCurrM: boolean;
          function LastCurrM: boolean;
          function PrevPred: boolean;
          function NextPred: boolean;
          function GotoPred(ID: integer): boolean;
          property PredID: Integer read fPredID write fPredID;
          property NCls: Integer read fNCls write fNCls;
          property NPred: Integer read fNPred write fNPred;
          property SDFflenme: string read fSDFflenme write fSDFflenme;
          property CurrM: integer read fCurrM write fCurrM;
          property CurrE: integer read fCurrE write fCurrE;
          property CurrP: integer read fCurrP write fCurrP;
          function GetWeightVal(Id: integer): double;
          procedure SetWeightVal(Id: integer; d: double);
          function ROC(cls: integer; SLROC: TStringList): double;
          ClsPrds: TAofCll2;
          ClsStat: TClsStats;
    end;

    function ClsDataCompare(Item1,Item2: Pointer): integer;
    function ClsConfCompare(Item1,Item2: Pointer): integer;

implementation

function ClsDataCompare(Item1, Item2: Pointer): integer;
var
   PClsD1, PClsD2: PTClsData;
begin
     PClsD1:=PTClsData(Item1); PClsD2:= PTClsData(Item2);
     Result:=0;
     if (PClsD1^.Exp<PClsD2^.Exp) then Result:=-1
     else if (PClsD1^.Exp>PClsD2^.Exp) then Result:=1
     //else if (PClsD1^.Exp=PClsD2^.Exp) then begin
     else begin
          if (PClsD1^.Preds[PClsD1^.PredID]<PClsD2^.Preds[PClsD2^.PredID]) then Result:=-1
          else if (PClsD1^.Preds[PClsD1^.PredID]>PClsD2^.Preds[PClsD2^.PredID]) then Result:=1
          else begin
               if (PClsD1^.Confidence[PClsD1^.PredID]<PClsD2^.Confidence[PClsD2^.PredID]) then Result:=-1
               else if (PClsD1^.Confidence[PClsD1^.PredID]>PClsD2^.Confidence[PClsD2^.PredID]) then Result:=1
          end;
     end;
end;

function ClsConfCompare(Item1, Item2: Pointer): integer;
var
   PClsD1, PClsD2: PTClsData;
begin
     PClsD1:=PTClsData(Item1); PClsD2:= PTClsData(Item2);
     Result:=0;
     if (PClsD1^.Confidence[PClsD1^.PredID]<PClsD2^.Confidence[PClsD2^.PredID]) then Result:=1
     else if (PClsD1^.Confidence[PClsD1^.PredID]>PClsD2^.Confidence[PClsD2^.PredID]) then Result:=-1
end;

{ TClsTbl }

procedure TClsTbl.SetPredID(ID: integer);
var
   i: integer;
begin
     for i:=0 to Count-1 do PTClsData(Items[i])^.PredID:=ID;
end;

procedure TClsTbl.SetLngthPPrds;
var
   PClsD: PTClsData;
   i,j: integer;
begin
     for i:=0 to Count-1 do begin
         PClsD:=PTClsData(Items[i]);
         SetLength(PClsD^.Preds,fNPred);
         for j:=Low(PClsD^.Preds) to High(PClsD^.Preds) do PClsD^.Preds[j]:=-1;
     end;
end;

procedure TClsTbl.SetLngthClsPrds;
var
   i: integer;
begin
     SetLength(ClsPrds,fNCls+1);
     for i:=Low(ClsPrds) to High(ClsPrds) do
         SetLength(ClsPrds[i],fNCls+1);
     InitClsPrds;
end;

procedure TClsTbl.InitClsPrds;
var
   i,j: integer;
begin
     for i:=Low(ClsPrds) to High(ClsPrds) do
         for j:=Low(ClsPrds[i]) to High(ClsPrds[i]) do begin
             ClsPrds[i,j].Pop:=0;
             ClsPrds[i,j].BMf:=-1;
             ClsPrds[i,j].BMl:=-1;
         end;
end;

constructor TClsTbl.Create;
begin
     fNCls:=1;
     fNPred:=1;
     fPredID:=0;
     fCurrM:=1;
     fCurrE:=-1;
     fCurrP:=-1;
     fSDFflenme:='';
     ClsStat:=TClsStats.Create;
     inherited Create;
end;

destructor TClsTbl.Destroy;
begin
     Clear;
     FreeAndNil(ClsStat);
     inherited Destroy;
end;

procedure TClsTbl.Clear;
var
   PClsD: PTClsData;
   i: integer;
   j:integer;
begin
     for i:=0 to Count-1 do begin
         PClsD:=PTClsData(Items[i]);
         if (PClsD<>nil) then dispose(PClsD);
     end;
     fNCls:=1;
     fNPred:=1;
     fPredID:=0;
     fCurrM:=1;
     fCurrE:=-1;
     fCurrP:=-1;
     fSDFflenme:='';
     SetLength(fWeights,0);
     for i:=Low(ClsPrds) to High(ClsPrds) do
         for j:=Low(ClsPrds[i]) to High(ClsPrds[i]) do SetLength(ClsPrds[i],0);
     SetLength(ClsPrds,0);
     inherited Clear;
end;

procedure TClsTbl.ReadTXT(nme: string);
var
   tmpSL,lneSL: TStringList;
   i,j: integer;
   PClsD: PTClsData;
begin
     Clear;
     tmpSL:=TStringList.Create;
     lneSL:=TStringList.Create;
     lneSL.Delimiter:=' ';
     tmpSL.LoadFromFile(nme);
     if FileExists(ChangeFileExt(nme,'.sdf')) then
        fSDFflenme:=ChangeFileExt(nme,'.sdf')
     else fSDFflenme:='';
     for i:=0 to tmpSL.Count-1 do begin
         lneSL.DelimitedText:=tmpSL.Strings[i];
         if (lneSL[0]='#SDF') then fSDFflenme:=lneSL[1]
         else if (lneSL[0]='#Classes') then begin
            fNCls:=StrToInt(lneSL[1]);
            SetLngthClsPrds;
         end else if (lneSL[0]='#Predictions') then begin
            fNPred:=StrToInt(lneSL[1]);
            SetLengthWeight(fNPred);
         end else if (lneSL[0]='#Weights') then begin
            for j:=1 to lneSL.Count-1 do fWeights[j-1]:=StrToFloat(lneSL[j]);
         end else begin
             new(PClsD);
             PClsD^.PredID:=0;
             SetLength(PClsD^.Preds,fNPred);
             SetLength(PClsD^.Confidence,fNPred);
             PClsD^.Id:=StrToInt(lneSL[0]);
             PClsD^.Exp:=StrToInt(lneSL[1]);
             //writeln('Low: '+IntToStr(Low(PClsD^.Preds))+' High: '+IntToStr(High(PClsD^.Preds))+' Count '+IntToStr(lneSL.Count));
             for j:=0 to fNPred-1 do
                 if (lneSL[j+2]<>'?') then
                    PClsD^.Preds[j]:=StrToInt(lneSL[j+2])
                 else PClsD^.Preds[j]:=fNCls;
             if ((fNPred*2+2)<=lneSL.Count) then
                for j:=0 to fNPred-1 do PClsD^.Confidence[j]:=StrToFloat(lneSL[j+2+fNPred])
             else
                 for j:=0 to fNPred-1 do PClsD^.Confidence[j]:=1;
             for j:=0 to fNPred-1 do if (PClsD^.Preds[j]=fNCls) then PClsD^.Confidence[j]:=0;
             Add(Pointer(PClsD));
         end;
     end;
     FreeAndNil(lneSL);
     FreeAndNil(tmpSL);
     SortOn(0);
     //
     FillClsPrds;
end;

procedure TClsTbl.ReadOUT(nme: string);
var
   tmpSL,lneSL,dataSL: TStringList;
   i,j: integer;
   lgt: integer;
   PClsD: PTClsData;
   Fnd: boolean;
   //
begin
     Clear;
     tmpSL:=TStringList.Create;
     lneSL:=TStringList.Create;
     dataSL:=TStringList.Create;
     dataSL.Delimiter:=':';
     lneSL.Delimiter:=' ';
     tmpSL.LoadFromFile(nme);
     //
     fNPred:=1;//Weka outputs contain no more than one prediction
     SetLength(fWeights,fNPred);
     fWeights[0]:=-1;
     if FileExists(ChangeFileExt(nme,'.sdf')) then
        fSDFflenme:=ChangeFileExt(nme,'.sdf')
     else fSDFflenme:='';
     i:=0; Fnd:=False;
     while ((i<tmpSL.Count) and (not Fnd)) do begin
           lneSL.DelimitedText:=tmpSL[i];
           if (lneSL.Count>0) then begin
              if (lneSL[0]='Relation:') then Fnd:=True;
           end;
           Inc(i);
     end;
     if (Fnd) then fSDFflenme:=lneSL[1];
     i:=0; Fnd:=False;
     while ((i<tmpSL.Count) and (not Fnd)) do begin
           lneSL.DelimitedText:=tmpSL[i];
           if (lneSL.Count>0) then
              if (lneSL[0]='inst#,actual,predicted,error,prediction') then Fnd:=True;
           Inc(i);
     end;
     if (Fnd) then begin
        lneSL.Delimiter:=',';
        j:=i;
        lgt:=length(tmpSL[j]);
        fNCls:=1;
        while (j<tmpSL.Count) and (lgt>0) do begin
              lneSL.DelimitedText:=tmpSL[j];
              //
              new(PClsD);
              SetLength(PClsD^.Preds,fNPred);
              SetLength(PClsD^.Confidence,fNPred);
              PClsD^.PredID:=0;
              PClsD^.Id:=StrToInt(lneSL[0]);
              dataSL.DelimitedText:=lneSL[1];
              PClsD^.Exp:=StrToInt(dataSL[0])-1;//Weka class output is in N*={1,2,3,...}
              if (PClsD^.Exp>=fNCls) then fNCls:=PClsD^.Exp+1;
              dataSL.DelimitedText:=lneSL[2];
              PClsD^.Preds[0]:=StrToInt(dataSL[0])-1;//Weka class output is in N*={1,2,3,...}
              if (length(lneSL[4])>0) then
                 PClsD^.Confidence[0]:=StrToFloat(lneSL[4])
              else PClsD^.Confidence[0]:=1;
              Add(Pointer(PClsD));
              //
              inc(j);
              if (j<tmpSL.Count) then lgt:=length(tmpSL[j]);
        end;
        SetLngthClsPrds;
     end;
     FreeAndNil(dataSL);
     FreeAndNil(lneSL);
     FreeAndNil(tmpSL);
     SortOn(0);
     //
     FillClsPrds;
end;

procedure TClsTbl.SortOn(ID: integer);
begin
     fPredID:=ID;
     SetPredID(ID);
     Sort(@ClsDataCompare);
end;

procedure TClsTbl.SetLengthWeight(Sze: integer);
var
   i: integer;
begin
     SetLength(fWeights,Sze);
     for i:=Low(fWeights) to High(fWeights) do fWeights[i]:=1;
end;

procedure TClsTbl.FillClsPrds;
var
   PClsD: PTClsData;
   i,j: integer;
   ExpOld, PredOld: integer;
begin
     PClsD:=PTClsData(Items[0]);
     ExpOld:=PClsD^.Exp;
     PredOld:=PClsD^.Preds[PClsD^.PredID];
     fCurrE:=ExpOld;
     fCurrP:=PredOld;
     fCurrM:=0;
     ClsPrds[PClsD^.Exp,PclsD^.Preds[PClsD^.PredID]].BMf:=0;
     for i:=0 to Count-1 do begin
         PClsD:=PTClsData(Items[i]);
         Inc(ClsPrds[PClsD^.Exp,PclsD^.Preds[PClsD^.PredID]].Pop);
         if ((PClsD^.Exp<>ExpOld) or (PClsD^.Preds[PClsD^.PredID]<>PredOld)) then begin
            ClsPrds[ExpOld,PredOld].BMl:=i-1;
            ExpOld:=PClsD^.Exp;
            PredOld:=PclsD^.Preds[PClsD^.PredID];
            ClsPrds[ExpOld,PredOld].BMf:=i;
         end;
     end;
     ClsPrds[ExpOld,PredOld].BMl:=i;//i-1;
     //
     ClsStat.InitConfusion(fNCls);
     for i:=Low(ClsPrds) to High(ClsPrds)-1 do
         for j:=Low(ClsPrds[i]) to High(ClsPrds[i])-1 do
             ClsStat.Confusion[i,j]:=ClsPrds[i,j].Pop;
     //for i:=Low(ClsPrds) to High(ClsPrds) do begin
     //    for j:=Low(ClsPrds[i]) to High(ClsPrds[i]) do
     //        write(IntToStr(ClsPrds[i,j].Pop)+'('+IntToStr(ClsPrds[i,j].BM)+') ');
     //    writeln;
     //end;
end;

function TClsTbl.GetClsPrds: TCelltbl;
begin
     Result.Pop:=0;
     Result.BMf:=-1;
     Result.BMl:=-1;
     if ((fCurrE>=0) and (fCurrP>=0)) then Result:=ClsPrds[fCurrE,fCurrP];
end;

function TClsTbl.SetCurrM(Exp, Pred: integer):boolean;
begin
     Result:=False;
     if (ClsPrds[Exp,Pred].BMf>=0) then begin
        fCurrM:=ClsPrds[Exp,Pred].BMf;
        fCurrE:=Exp;
        fCurrP:=Pred;
        Result:=True;
     end;
end;

function TClsTbl.FirstCurrM: boolean;
begin
     fCurrM:=ClsPrds[fCurrE,fCurrP].BMf;
     Result:=True;
end;

function TClsTbl.PrevCurrM: boolean;
begin
     Result:=False;
     if ((fCurrM-1)>=ClsPrds[fCurrE,fCurrP].BMf) then begin
        Dec(fCurrM);
        Result:=True;
     end;
end;

function TClsTbl.NextCurrM: boolean;
begin
     Result:=False;
     if ((fCurrM+1)<=ClsPrds[fCurrE,fCurrP].BMl) then begin
        Inc(fCurrM);
        Result:=True;
     end;
end;

function TClsTbl.LastCurrM: boolean;
begin
     fCurrM:=ClsPrds[fCurrE,fCurrP].BMl;
     Result:=True;
end;

function TClsTbl.PrevPred: boolean;
begin
     Result:=False;
     if (fPredID-1>=0) then begin
        Dec(fPredID);
        SortOn(fPredID);
        InitClsPrds;
        FillClsPrds;
        Result:=True;
     end;
end;

function TClsTbl.NextPred: boolean;
begin
     Result:=False;
     if (fPredID+1<fNPred) then begin
        Inc(fPredID);
        SortOn(fPredID);
        InitClsPrds;
        FillClsPrds;
        Result:=True;
     end;
end;

function TClsTbl.GotoPred(ID: integer): boolean;
begin
     Result:=False;
     if ((ID>=0) and (ID<fNPred)) then begin
        fPredID:=ID;
        SortOn(fPredID);
        InitClsPrds;
        FillClsPrds;
        Result:=True;
     end;
end;

function TClsTbl.GetWeightVal(Id: integer): double;
begin
     Result:=fWeights[Id];
end;

procedure TClsTbl.SetWeightVal(Id: integer; d: double);
begin
     fWeights[Id]:=d;
end;

function TClsTbl.ROC(cls: integer; SLROC: TStringList): double;
var
   i,PrId: integer;
   TP,TN,FP,FN,TPFN: integer;
   PClsD: PTClsData;
   thrd, Se, Sp, Sptmp, ROCAUC: double;
begin
     SLROC.Add('"1-Specificity";"Selectivity";"Threshold"');
     TPFN:=0;
     for i:=0 to Count-1 do begin
         PClsD:=Items[i];
         PrId:=PClsD^.PredID;
         if (PClsD^.Preds[PrId]<>cls) then PClsD^.Confidence[PrId]:=-PClsD^.Confidence[PrId];
         if (PClsD^.Exp=cls) and (PClsD^.Preds[PredId]<fNCls) then inc(TPFN);
     end;
     Sort(@ClsConfCompare);
     //
     TP:=0; FP:=0; TN:=0; FN:=0;
     Se:=0; Sp:=0; Sptmp:=1; ROCAUC:=0;
     i:=0; PClsD:=Items[i]; PrId:=PClsD^.PredID;
     thrd:=PClsD^.Confidence[PrID];
     SLROC.Add('0;0;'+FloatToStr(thrd));
     while (i<Count) do begin
           PClsD:=Items[i]; PrId:=PClsD^.PredID;
           if (PClsD^.Confidence[PredID]<thrd) and (PClsD^.Preds[PredId]<fNCls) then begin
              FN:=TPFN-TP;
              TN:=Count-TP-FP-FN;
              if ((TP+FP)>0) then Sp:=TN/(TN+FP);
              ROCAUC:=ROCAUC+Se*((1-Sp)-Sptmp);
              Sptmp:=1-Sp;
              if (TPFN>0) then Se:=TP/TPFN;
              SLROC.Add(FloatToStr(1-Sp)+';'+FloatToStr(Se)+';'+FloatToStr(thrd));
              thrd:=PClsD^.Confidence[PredID];
           end;
           if (PClsD^.Exp=cls) then inc(TP) else inc(FP);
           inc(i);
     end;
     ROCAUC:=ROCAUC+Se*(1-Sptmp);
     SLROC.Add('1;1;'+FloatToStr(thrd));
     Result:=ROCAUC;
     //
     for i:=0 to Count-1 do begin
         PClsD:=Items[i];
         PrId:=PClsD^.PredID;
         if (PClsD^.Preds[PrId]<>cls) then PClsD^.Confidence[PrId]:=-PClsD^.Confidence[PrId];
     end;
     Sort(@ClsDataCompare);
end;

end.

